我有如下代码VB连接SQL SEVER2000
modul1中
Public flagCedit As Boolean
Public gintCmode As Boolean
Public gintTmode As Integer
Public gintrmode As Integer
Public gintbmode As Integer
Public flagsedit As Boolean
Public username As String
Public txtsql As String
Public mblchange As Boolean
Public js As Integer
Public Function ExecuteSQL(ByVal SQL As String, Msgstring As String) As ADODB.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", 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
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
Public Function connectString() As String
connectString = "=fileDSN=LYMIS.dsn;UID=;PWD="
End Function
Public Sub enterTOTab(keyasc As Integer)
If keyasc = 13 Then
SendKeys "{TAB}"
End If
End Sub
Public Function testtxt(Txt As String) As Boolean
If Trim(Txt) = "" Then
testtxt = False
Else
testtxt = True
End If
End Function
Sub main()
Dim flogin As New Frmlogin
flogin.Show vbModal
If Not flogin.OK Then
End
End If
Unload flogin
Set fmainform = New frmmain
fmainform.Show
End Sub
登陆窗体中
Option Explicit
Public OK As Boolean
Dim micount As Integer
Private Sub from_load()
OK = False
micount = 0
End Sub
Private Sub cmdCancel_Click()
OK = False
Me.Hide
End Sub
Private Sub cmdok_Click()
Dim txtsql As String
Dim mrc As ADODB.Recordset
Dim msgtext As String
username = ""
If Trim(User.Text = "") Then
MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
User.SetFocus
Else
txtsql = "SELECT*FROM User WHERE UserName ='" & User.Text & "'"
Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF = True Then
MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
User.SetFocus
Else
If Trim(mrc.Fields(1)) = Trim(Pwd.Text) Then
OK = True
mrc.Close
Me.Hide
username = Trim(User.Text)
Else
MsgBox "输入密码不正确,请重新输入!", vbOKOnly + vbExclamation, "警告"
Pwd.SetFocus
Pwd.Text = ""
End If
End If
End If
micount = micount + 1
If micount = 3 Then
Me.Hide
End If
Exit Sub
End Sub
运行后 command提示“对象变量或with块变量未设置”
哪位大哥大姐帮忙指点一下
跪求
modul1中
Public flagCedit As Boolean
Public gintCmode As Boolean
Public gintTmode As Integer
Public gintrmode As Integer
Public gintbmode As Integer
Public flagsedit As Boolean
Public username As String
Public txtsql As String
Public mblchange As Boolean
Public js As Integer
Public Function ExecuteSQL(ByVal SQL As String, Msgstring As String) As ADODB.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", 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
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
Public Function connectString() As String
connectString = "=fileDSN=LYMIS.dsn;UID=;PWD="
End Function
Public Sub enterTOTab(keyasc As Integer)
If keyasc = 13 Then
SendKeys "{TAB}"
End If
End Sub
Public Function testtxt(Txt As String) As Boolean
If Trim(Txt) = "" Then
testtxt = False
Else
testtxt = True
End If
End Function
Sub main()
Dim flogin As New Frmlogin
flogin.Show vbModal
If Not flogin.OK Then
End
End If
Unload flogin
Set fmainform = New frmmain
fmainform.Show
End Sub
登陆窗体中
Option Explicit
Public OK As Boolean
Dim micount As Integer
Private Sub from_load()
OK = False
micount = 0
End Sub
Private Sub cmdCancel_Click()
OK = False
Me.Hide
End Sub
Private Sub cmdok_Click()
Dim txtsql As String
Dim mrc As ADODB.Recordset
Dim msgtext As String
username = ""
If Trim(User.Text = "") Then
MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
User.SetFocus
Else
txtsql = "SELECT*FROM User WHERE UserName ='" & User.Text & "'"
Set mrc = ExecuteSQL(txtsql, msgtext)
If mrc.EOF = True Then
MsgBox "没有这个用户,请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
User.SetFocus
Else
If Trim(mrc.Fields(1)) = Trim(Pwd.Text) Then
OK = True
mrc.Close
Me.Hide
username = Trim(User.Text)
Else
MsgBox "输入密码不正确,请重新输入!", vbOKOnly + vbExclamation, "警告"
Pwd.SetFocus
Pwd.Text = ""
End If
End If
End If
micount = micount + 1
If micount = 3 Then
Me.Hide
End If
Exit Sub
End Sub
运行后 command提示“对象变量或with块变量未设置”
哪位大哥大姐帮忙指点一下
跪求