连接无法用于执行此操作。在此上下文中它可能已被关闭或无效。的问题

Question

输入账号密码 点 确定 显示连接无法用于执行此操作。在此上下文中它可能已被关闭或无效。  希望高手解决下Option ExplicitDim dummy As adodb.Recordset
Dim dummy2 As adodb.RecordsetDim ctr As Integer
Dim hDesk As Long
Dim Thwnd As LongPrivate Sub Closed_Click()
    Me.Hide
    UnloadAllForms
    End
    
End SubPrivate Sub Closed_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(Closed.hDC, 0, 0, 73, 50, Source.hDC, 18, 107, SRCCOPY)
    Closed.Refresh
End SubPrivate Sub Closed_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(Closed.hDC, 0, 0, 73, 50, Source.hDC, 0, 107, SRCCOPY)
    Closed.Refresh
End SubPrivate Sub cmdCancel_Click()
    Me.Hide
    End
End SubPrivate Sub cmdCancel_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton(" 取消", cmdCancel, 0, 0, 73, 50, Source, 74, 0, 1)
End SubPrivate Sub cmdCancel_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton(" 取消", cmdCancel, 0, 0, 73, 50, Source, 0, 0, 1)
End SubPrivate Sub cmdOk_Click()
    Dim strs As String
    If Get_User(txtUserName, txtPassword) Then
        Me.Hide
        frmMain.Show
        Today = Now
        frmMain.StatusMessage = " 当前用户: " + txtUserName + _
                                "           " + Format(Today, "dddd ") + "    " + Format(Today, "yyyy-mm-dd")
        frmMain.MenuList.SetFocus
    Else
        ctr = ctr + 1
        If ctr = 4 Then
           End
        Else
           Call MessageBox("frmLogin", "非法用户!!!!   请重试．．．．  你还剩" + str(4 - ctr) + " 机会", 0)
           SendKeys "{Home}+{End}"
        End If
   End If
End SubPrivate Sub cmdOk_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("     确定", cmdOk, 0, 0, 73, 50, Source, 74, 0, 1)
End SubPrivate Sub cmdOk_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call MacButton("     确定", cmdOk, 0, 0, 73, 50, Source, 0, 0, 1)
    
End SubPrivate Sub Form_Load()
    On Error Resume Next
    Dim Thwnd As Long
    Dim RetValue
    'RetValue = ChangeRes(800, 600, 32)
    Call CreateMacOSTitleBar(titleBar, "系统登录")
    Call MacButton("登录", cmdOk, 0, 0, 73, 50, Source, 0, 0, 1)
    Call MacButton("退出", cmdCancel, 0, 0, 73, 50, Source, 0, 0, 1)
    Call BitBlt(Help.hDC, 0, 0, 73, 50, Source.hDC, 0, 90, SRCCOPY)
    Help.Refresh
    Call BitBlt(Closed.hDC, 0, 0, 73, 50, Source.hDC, 0, 107, SRCCOPY)
    Closed.Refresh
    Call ColForm(BoxContainer, 217, 211, 213, 125)
    frmWallpaper.Show
    KeyPreview = True
    'modDB.opencn
    Set myDB = New adodb.Connection
    'myDB.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" + App.Path + "\DATABASE\POS.mdb"
    'MsgBox "Provider=Microsoft.Jet.OLEDB.4.0;Persist Security Info=False;Data Source=" + App.Path + "\DATABASE\POS.mdb"
    myDB.ConnectionString = "Provider=sqloledb;Data Source=(local);UID=sa;PWD=123;DATABASE=POS"
    myDB.Open    
   Set dummy2 = New adodb.Recordset
    dummy2.Open "select * from SETUP order by COMPANY_NAME", myDB, 1, 3
    
    If dummy2.EOF Then
        dummy2.AddNew
        dummy2("COMPANY_NAME") = "驰锐超市管理系统"
        dummy2.Update
    End If
End SubPrivate Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
    Select Case KeyCode
        Case vbKeyEscape:
                Me.Hide
                UnloadAllForms
                End
    End Select
    If (Shift = vbAltMask) Then
        Select Case KeyCode
            Case vbKeyF4
                    KeyCode = 0
        End Select
    End If
End SubPrivate Sub Help_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call BitBlt(Help.hDC, 0, 0, 73, 50, Source.hDC, 0, 90, SRCCOPY)
    Help.Refresh
End SubFunction TrialerActivation()
    On Error Resume Next
    If GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Times Opened") = "Error" Then
        CreateKey "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS"
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Times Opened", "1"
    End If
    If GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Times Opened") = "" Then
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Times Opened", "1"
    End If
    If GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Expire Date") = "Error" Then
        CreateKey "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS"
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Expire Date", Now + 29
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Trial Start Date", Now
    End If
    If GetStringValue("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Expire Date") = "" Then
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Expire Date", Now + 29
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Trial Start Date", Now
    End If
        CreateKey "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS"
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Todays Date", Now
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Copyright", App.LegalCopyright
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Trade Mark", App.LegalTrades
        SetStringValue "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\WANCOM SYSTEMS", "Version", App.Major & "." & App.Minor & "." & App.Revision    Exit Function
End FunctionPrivate Sub titleBar_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    Call DragForm(Me)
End SubFunction Get_User(p_user As String, p_pass As String) As Boolean
    Dim strs As String
    Dim tempstr As String
    strs = ""
    tempstr = Decode_Pass(p_pass)
    strs = "select * from USER_PASSWORD where USER_NAME = '" & p_user & "'" _
            & " and USER_PASSWORD = '" & p_pass & "'" 'Decode_Pass(p_pass) & "'"
    Debug.Print strs
    'MsgBox myDB
    Set dummy = New adodb.Recordset
    dummy.Open strs, myDB, 1, 3
    If Not dummy.BOF Then
        Get_User = True
        frmMain.MenuList.Clear
        If dummy("USER_ALLOW_SM") = True Then frmMain.MenuList.AddItem "供应商(S)"
        If dummy("USER_ALLOW_PM") = True Then frmMain.MenuList.AddItem "商品信息(P)"
        If dummy("USER_ALLOW_CM") = True Then frmMain.MenuList.AddItem "商品分类(G)"
        If dummy("USER_ALLOW_ST") = True Then frmMain.MenuList.AddItem "前台销售(F)"
        If dummy("USER_ALLOW_RT") = True Then frmMain.MenuList.AddItem "入库信息(I)"
        If dummy("USER_ALLOW_PS") = True Then frmMain.MenuList.AddItem "权限设置(Q)"
    Else
         Get_User = False
    End If
    dummy.Close
End FunctionPrivate Sub txtPassword_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then cmdOk_Click
End Sub
Private Sub txtUserName_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then txtPassword.SetFocus
End Sub

Answer 1

由于myDB并非全局变量，所以以下过程中 dummy.Open strs, myDB, 1, 3中的myDB等于没有定义，所以就是连接不存在，就打开记录集，所以出错。Function Get_User(p_user As String, p_pass As String) As Boolean
  Dim strs As String
  Dim tempstr As String
  strs = ""
  tempstr = Decode_Pass(p_pass)
  strs = "select * from USER_PASSWORD where USER_NAME = '" & p_user & "'" _
  & " and USER_PASSWORD = '" & p_pass & "'" 'Decode_Pass(p_pass) & "'"
  Debug.Print strs
  'MsgBox myDB
  Set dummy = New adodb.Recordset
  dummy.Open strs, myDB, 1, 3
  If Not dummy.BOF Then
  Get_User = True
  frmMain.MenuList.Clear
  If dummy("USER_ALLOW_SM") = True Then frmMain.MenuList.AddItem "供应商(S)"
  If dummy("USER_ALLOW_PM") = True Then frmMain.MenuList.AddItem "商品信息(P)"
  If dummy("USER_ALLOW_CM") = True Then frmMain.MenuList.AddItem "商品分类(G)"
  If dummy("USER_ALLOW_ST") = True Then frmMain.MenuList.AddItem "前台销售(F)"
  If dummy("USER_ALLOW_RT") = True Then frmMain.MenuList.AddItem "入库信息(I)"
  If dummy("USER_ALLOW_PS") = True Then frmMain.MenuList.AddItem "权限设置(Q)"
  Else
  Get_User = False
  End If
  dummy.Close
End Function

Answer 2

myDB应为模块级变量，未见定义；再者在Form_load事件中应保证myDB的初始化工作一定要在其他方法使用之前。