高手帮我看看问题出在哪里

Question

Private Sub cmdInsert_Click()
Dim rs As ADODB.Recordset
'Dim cnn As ADODB.Connection
Dim str As String
Dim msgtext As String
If Trim(txtuser.Text) = "" Then
     MsgBox "用户名不能为空", vbOKOnly + vbExclamation, "警告"
Else
  str = "select * from czydmb"
 Set rs = New ADODB.Recordset
  'Set con = New ADODB.Connection
  Set rs = ExecuteSQL(str, msgtext)
  While Not rs.EOF        
  '问题出在这里:"  实时错误'91'   对象变量或'WITH'块变量未设置"
     If (Trim(rs.Fields(0)) = Trim(txtuser)) Then
        MsgBox "用户已存在重新输入", vbOKOnly + vbExclamation, "警告"
        Exit Sub
     Else
         rs.MoveNext
     End If
 Wend
  rs.AddNew
  rs.Fields(0) = Trim(txtuser.Text)
  'rs.Fields(1) = ""
 ' rs.Fields(2) = ""
  rs.Fields(3) = Trim(txtpwd.Text)
  rs.Update
  rs.Close
  txtuser.Text = ""
  txtpwd.Text = ""
  MsgBox "添加用户成功", vbOKOnly, "恭喜"
End If
End SubPublic Function ExecuteSQL(ByVal SQL As String, MsgString As String) As Recordset
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim strCnn As String
    Dim sTokens() As String
    Set cnn = New ADODB.Connection
    
    
    On Error GoTo ExecuteSQL_Error
    
    sTokens = Split(SQL)
    strCnn = "Provider=sqloledb.1;user id=sa;password=;Initial Catalog=gkwxgl;Data Source=gkwxgl"    cnn.Open strCnn
    If InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then
        cnn.Execute SQL
        MsgString = sTokens(0) & "Query Successful"
    Else
        Set rst = New ADODB.Recordset
        rst.Open SQL, cnn, adOpenKeyset, adLockOptimistic
        Set ExecuteSQL = rst
        MsgString = "查询到" & rst.RecordCount & "条记录"
        Debug.Print MsgString
    End If
ExecuteSQL_Exit:
    Set cnn = Nothing
    Set rst = Nothing
    Exit Function
    
ExecuteSQL_Error:
    MsgBox "没有连接到数据库", vbOKOnly + vbExclamation, "警告"
    Resume ExecuteSQL_Exit    
    End Function

Answer 1

If Trim(txtuser.Text) = "" Then
     MsgBox "用户名不能为空", vbOKOnly + vbExclamation, "警告"
Else
     str="select * from czydmb where 操作员姓名='"& txtuser.text &"'"
     if rs.state=adstateopen then rs.close
     rs.open str,conn,adopenkeyset,adlockreadonly
     if rs.recorccount>0 then
         MsgBox "用户已存在重新输入", vbOKOnly + vbExclamation, "警告"
         Exit Sub
     Else
         conn.execute "insert into czydmb(...) values(...)"
     End If

Answer 2

ExecuteSQL过程没有返回相应的记录集(recordset),请逐句调试看看是什么条件没有满足。

Answer 3

也就是说，当经过function ExecuteSQL后，此时的rs仍然是nothing

Answer 4

'......
 str = "select * from czydmb"
 Set rs = New ADODB.Recordset
 Set rs = ExecuteSQL(str, msgtext) '**********************************
 if isnothing(rs) then
    msgbox "No recordset returned!"
 end if
 '**********************************
  While Not rs.EOF      
 '......  

Answer 5

'**********************************
 if isnothing(rs) then
    msgbox "No recordset returned!"
    Exit Sub
 end if
 '**********************************

Answer 6

…………
 Debug.Print MsgString ---》看看这个地方的返回结果是什么？
…… …………
再在这个地方扑获异常：
ExecuteSQL_Exit:
    MsgBox Err.Description
    Set cnn = Nothing
    Set rst = Nothing
    Exit Function

Answer 7

这段代码是许多下载的软件上写的规范代码，其实有问题：就在下面的代码中。即当InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0)))成立时，就没有返回记录集(此时rs肯定是nothing；因此凡调用这个函数的，应该判断rs是否已经返回，如果没有返回记录集，来个rs.eof肯定就会出现楼主的错误。
   If InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then
        cnn.Execute SQL
        MsgString = sTokens(0) & "Query Successful"
    Else
        Set rst = New ADODB.Recordset
        rst.Open SQL, cnn, adOpenKeyset, adLockOptimistic
        Set ExecuteSQL = rst
        MsgString = "查询到" & rst.RecordCount & "条记录"
        Debug.Print MsgString
    End If
这个函数应改如下：Public Function ExecuteSQL(ByVal SQL As String, MsgString As String,rs As Recordset) as boolean
    Dim cnn As ADODB.Connection
    Dim rst As ADODB.Recordset
    Dim strCnn As String
    Dim sTokens() As String
    Set cnn = New ADODB.Connection
    
    
    On Error GoTo ExecuteSQL_Error
    
    sTokens = Split(SQL)
    strCnn = "Provider=sqloledb.1;user id=sa;password=;Initial Catalog=gkwxgl;Data Source=gkwxgl"    cnn.Open strCnn
    If InStr("INSERT,DELETE,UPDATE", UCase$(sTokens(0))) Then
        cnn.Execute SQL
        MsgString = sTokens(0) & "Query Successful"
        ExecuteSQL=false
    Else
        Set rst = New ADODB.Recordset
        rst.Open SQL, cnn, adOpenKeyset, adLockOptimistic
        Set rs = rst
        ExecuteSQL =true
        MsgString = "查询到" & rst.RecordCount & "条记录"
        Debug.Print MsgString
    End If
ExecuteSQL_Exit:
    Set cnn = Nothing
    Set rst = Nothing
    Exit Function
    
ExecuteSQL_Error:
    ExecuteSQL=false
    MsgBox "没有连接到数据库", vbOKOnly + vbExclamation, "警告"
    Resume ExecuteSQL_Exit  
    End Function调用时，就这样if ExecuteSQL(str, msgtext,rs) then  '此时返回记录集，可对rs作相关操作
   if rs.eof----------
else  '此时没有返回记录集，不能对rs作相关操作
   exit sub
end if   

Answer 8

用下面的函数试试，（我以前经常用的，好象和你的差不多）Public Function ExecuteSQL(ByVal SQL _
As String, msgstring As String) _
As ADODB.Recordset '传递参数SQL查询语句，MsgString传递查询信息
Dim cnn As ADODB.Connection '定义连接
Dim rst As ADODB.Recordset
Dim strCnn As String'定义字符串
Dim sTokens() As String
'异常
On Error GoTo ExecuteSQL_Error
'用split函数产生一个包含各个子串的数组
sTokens = Split(SQL)
'创建连接
Set cnn = New ADODB.Connection
'数据连接
 strCnn = "Provider=sqloledb.1;user id=sa;password=;Initial Catalog=gkwxgl;Data Source=gkwxgl"
cnn.Open strCnn '打开连接
'判断字符串中是否含有指定内容
   If InStr("INSERT,DELETE,UPDATE", _
      UCase$(sTokens(0))) Then
      cnn.Execute SQL  '查询语句
      msgstring = sTokens(0) & _
         " 查询成功"
   Else
      Set rst = New ADODB.Recordset '创建数据集对象
      '返回查询结果
      rst.Open Trim$(SQL), cnn, _
         adOpenKeyset, _
         adLockOptimistic
      'rst.MoveLast     'get RecordCount
      Set ExecuteSQL = rst
      msgstring = "查询到" & rst.RecordCount & _
         " 条记录 "
   End If
ExecuteSQL_Exit:
   msgstring= Err.Description  '--->多加一些异常捕获，一步一步排查
   Set rst = Nothing
   Set cnn = Nothing
   Exit Function
   
ExecuteSQL_Error:
   msgstring = "查询错误: " & _
      Err.Description
   Resume ExecuteSQL_Exit
End Function

Answer 9

我这段代码中SQL 语句，第一个是SELECT，不满足inStr("UPDATE,DELETE,INSERT",
UCase$(sTokens(0))) ,rst is not nothing

Answer 10

你要访问RecordCount，要设为本地连接．否则得到的是－１