问MySQL运行时错误'-2147217865 (80040e37)‘

EN

Option Explicit

Public Function Connected2DB() As Boolean
Dim isOpen      As Boolean
Dim ANS         As VbMsgBoxResult
Dim dbpath As String

    isOpen = False
    On Error GoTo err

    Do Until isOpen = True
      CN.CursorLocation = adUseClient
      CN.ConnectionString = "Provider=MSDASQL;Driver={MySQL ODBC 5.2 ANSI Driver};DSN=myDSN;Server=MyIPAddress;Database=myDatabase;Uid=DBUserName;Pwd=mypassword;Port=3306;"
      CN.Open
      isOpen = True
    Loop
    Connected2DB = isOpen
    Exit Function
err:
    ANS = MsgBox("Error Number: " & err.Number & vbCrLf & "Description: " & err.Description, _
  vbCritical + vbRetryCancel)
  If ANS = vbCancel Then
    Connected2DB = False
  ElseIf ANS = vbRetry Then
    Connected2DB = vbRetry
  End If
End Function

Public Sub CloseDB()
    'Close the connection
    CN.Close
    Set CN = Nothing
End Sub

Private Sub cmdLogin_Click()
Dim strPass As String

If txtUsername.Text = "" Then
    MsgBox "Username and/or Password is incorrect.Try Again!", vbExclamation
    txtUsername.SetFocus
    Exit Sub
End If

If txtPassword.Text = "" Then
    MsgBox "Username and/or Password is incorrect.Try Again!", vbExclamation
    txtPassword.SetFocus
    Exit Sub
End If

strPass = Encode(txtPassword.Text)
'strPass = txtPassword.Text

Set RS = New ADODB.Recordset
'If RS.State = adStateOpen Then RS.Close
RS.Open "SELECT tblUsers.* FROM tblUsers WHERE Username='" & txtUsername.Text & "' AND Password ='" & strPass & "' AND StatusCD ='ACTIVE'", CN, adOpenStatic, adLockReadOnly
If RS.RecordCount < 1 Then
    Attempt = Attempt - 1
    MsgBox "Username and/or Password is incorrect.Try Again!", vbExclamation
    lblAttempt.Caption = "Remaining Attempt(s): " & Attempt

    If Attempt = 0 Then
        MsgBox "You have reached maximum login attempts. System will now be terminated!", vbExclamation

        MDIMain.CloseMe = True
        END_APP = True
        Unload Me
    End If
Else
    LOGIN_SUCCEEDED = True

    ACTIVE_USER.USERID = RS.Fields("UserCD")
    ACTIVE_USER.FULLNAME = RS.Fields("Fullname")
    ACTIVE_USER.USERNAME = RS.Fields("Username")
    ACTIVE_USER.PASSCODE = RS.Fields("Password")
    ACTIVE_USER.USER_ISADMIN = CBool(changeYNValue(getValueAt("SELECT Username,IsAdmin FROM tblUsers WHERE Username='" & txtUsername.Text & "'", "IsAdmin")))

    blnCreate = CBool(changeYNValue(RS.Fields("ModCreate")))
    blnUpdate = CBool(changeYNValue(RS.Fields("ModUpdate")))
    blnDelete = CBool(changeYNValue(RS.Fields("ModDelete")))

    'InsertLogs Name, "Action Taken: Logged in to the Program", "Executed:" & Time

    MDIMain.lblCurrentUser.Caption = ACTIVE_USER.FULLNAME
    MDIMain.lblDate.Caption = Now() 'Format(Now, "MMMM dd, yyyy")

    Unload Me
    MDIMain.Show
End If
End Sub