Private Sub cmdOk_Click()
UserName = "sa"
If Trim(txtUserName.Text = "") Then
MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
txtUserName.SetFocus
Else
sql = "select * from userpwd where U_name = " & "'" & txtUserName.Text & "'"
Set rs = ExecuteSQL(sql, msgtxt)
If rs.EOF = True Then (这里出了问题)
MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
txtUserName.SetFocus
Else
If Trim(rs.Fields(1)) = Trim(txtPassword.Text) Then
OK = True
UserName = Trim(txtUserName.Text)
UserPass = Trim(txtPassword.Text)
rs.Close
Me.Hide
Else
MsgBox "输入密码不正确,请重新输入!", vbOKOnly + vbExclamation, "警告"
txtPassword.SetFocus
txtPassword.Text = ""
End If
End If
End If
ExecuteSQL函数
Public Function ExecuteSQL(ByVal sql _
As String, MsgString As String) _
As ADODB.Recordset
'executes SQL and returns Recordset
Dim cnn As ADODB.Connection
Dim rst As ADODB.Recordset
Dim sTokens() As String
On Error GoTo ExecuteSQL_Error
sTokens = Split(sql)
Set cnn = New ADODB.Connection
cnn.Open ConnectString
If InStr("INSERT,DELETE,UPDATE,EXECUTE", _
UCase$(sTokens(0))) Then
cnn.Execute (sql)
MsgString = sTokens(0) & _
" query successful"
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:
Set rst = Nothing
Set cnn = Nothing
Exit Function
ExecuteSQL_Error:
MsgString = "查询错误: " & _
Err.Description
Resume ExecuteSQL_Exit
End Function
我也不会调试。据说是VB If mrc.EOF = True Then 实时错误 91 据说ExecuteSQL函数出问题,可以帮我改下么。谢谢你,很急~
慕桂英4014372
忽然笑
相关分类