Option Explicit‘这是公共模块

Public adocon As ADODB.Connection
Public adminp As Boolean
Public readp As Boolean
Public username As String

Public Function executesql(ByVal sql As String) As ADODB.Recordset
Dim rst As ADODB.Recordset
Set adocon = New ADODB.Connection
adocon.CursorLocation = adUseClient
adocon.ConnectionString = Connstring
adocon.Open
Dim stokens() As String
On Error GoTo executesql_error
stokens = Split(sql, " ")
If InStr("inser,delete,update", UCase(stokens(0))) Then
adocon.Execute sql
Else
Set rst = New ADODB.Recordset
rst.Open Trim(sql), adocon, adOpenKeyset, adLockOptimistic
Set executesql = rst
End If
executesql_exit:
Set rst = Nothing
Set adocon = Nothing
Exit Function
executesql_error:
Resume executesql_exit

End Function

Public Function Connstring() As String

Connstring = "provider = microsoft.Jet.OLEDB.4.0;Data source =" & App.Path & "\123.mdb "
End Function
Public Function executeqx() As Boolean
Dim sql As String
Dim rst As ADODB.Recordset
Set adocon = New ADODB.Connection
adocon.ConnectionString = Connstring
adocon.Open
Set rst = New ADODB.Recordset
sql = "select * from use where username='" & username & "'"
rst.Open Trim(sql), adocon, adOpenKeyset, adLockOptimistic
If rst.EOF = True Then
MsgBox "非法用户", vbExclamation + vbOKOnly, "警告"
executeqx = Null
Exit Function
End If
If rst.Fields("admin") Then
executeqx = True
Exit Function
ElseIf rst.Fields("readonly") Then
executeqx = False
End If
rst.Close
On Error GoTo executesql_error
executesql_exit:
Set rst = Nothing
Set adocon = Nothing
Exit Function
executesql_error:
Resume exectuesql_exit

End Function

’这是登录窗体代码
Private Sub Command1_Click()
Dim txtsql As String
Dim mrc As New ADODB.Recordset
txtsql = "select username from use where username=" & Trim(Text1.Text) & ""
Set mrc = executesql(txtsql)
If mrc.EOF = True Then
MsgBox "用户名错误！", vbExclamation + vbOKOnly, "警告"
Text1.SetFocus
Text1.SelStart = 0
Text1.SelLength = Len(Text1.Text)
Exit Sub
End If
username = mrc.Fields(0)
txtsql = "select username from use where password=" & Trim(Text2.Text) & ""
Set mrc = executesql(txtsql)
If mrc.EOF = True Then
MsgBox "密码错误！", vbExclamation + vbOKOnly, "警告"
Text2.SetFocus
Text2.SelStart = 0
Text2.SelLength = Len(Text1.Text)
Exit Sub
End If
If executeqx Then
adminp = True
Else
readp = True
End If

End Sub

Private Sub Command2_Click()
end
End Sub
运行时出现了“对象关闭时不允许操作”实时错误3704，请问大家怎么改呢？

這麼多代碼，也不標明運行到哪 一行出的這個錯。。。誰有時間去幫你看。。。

連接出了問題

Set mrc = executesql(txtsql)
我估计是这个错误.
这个在网上已经看过几千万次了.

说明recordset没有打开，问题在打开表的那条语句中。

就我的这个程序，怎么改呢？

不标明那里出错，这么长的代码很难一一去看~

我的也是这个问题啊位高手给指导一下呀





Option Explicit
Private Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpbuffer As String, nSize As Long) As Long


Public OK As Boolean
'记录确定次数
Dim miCount As Integer
Private Sub Form_Load()
    Dim sBuffer As String
    Dim lSize As Long


    sBuffer = Space$(255)
    lSize = Len(sBuffer)
    Call GetUserName(sBuffer, lSize)
    If lSize > 0 Then
        txtUserName.Text = ""
   
    Else
        txtUserName.Text = vbNullString
    End If
   

    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
    'ToDo: create test for correct password
    'check for correct password
   
    UserName = ""
    If Trim(txtUserName.Text = "") Then
        MsgBox "没有这个用户，请重新输入用户名！", vbOKOnly + vbExclamation, "警告"
        txtUserName.SetFocus
    Else
        txtSQL = "select * from user_Info where user_ID = '" & txtUserName.Text & "'"
        Set mrc = ExecuteSQL(txtSQL, MsgText)
        If mrc.EOF = True Then
            MsgBox "没有这个用户，请重新输入用户名!", vbOKOnly + vbExclamation, "警告"
            txtUserName.SetFocus
        Else
            If Trim(mrc.Fields(1)) = Trim(txtPassword.Text) Then
                OK = True
                mrc.Close
                Me.Hide
                UserName = Trim(txtUserName.Text)
            Else
                MsgBox "输入密码不正确，请重新输入！", vbOKOnly + vbExclamation, "警告"
                txtPassword.SetFocus
                txtPassword.Text = ""
            End If
        End If
    End If
   
    miCount = miCount + 1
    If miCount = 3 Then
        Me.Hide
    End If
    Exit Sub
End Sub

那是没有资料