Как мне зафиксировать конкретную c SQL ошибку сервера в Access VBA, в которой отсутствует код ошибки доступа? - PullRequest
Новая
       85

Как мне зафиксировать конкретную c SQL ошибку сервера в Access VBA, в которой отсутствует код ошибки доступа?

1 голос
/ 18 июня 2020

У меня есть форма входа в Access, которая отправляет имя пользователя и pwd в строку подключения ODB C для подключения к SQL серверу (Express) на месте. Если они вводят учетные данные неправильно, я бы хотел, чтобы появился пользовательский msgbox, а не эти 4 оконных сообщения от SQL Server и Access, нервно сообщающие пользователю, что они неправильно что-то вводят. Поскольку в первых двух нет сообщения об ошибке доступа, я не уверен, как их перехватить и поместить что-то на место.

Вот моя обработка ошибок, которая обычно работает для меня с все, но не для SQL сервера: 

Private Sub cmdLogin_Click()
'Stop
On Error GoTo Err_Login

    Dim varUserName As String
    Dim varPassword As String
    Dim vardim As String
    Dim varCreds As String

    varUserName = Me.txtUserName
    varPassword = Nz(Me.txtPassword, vbNullString)
    varCreds = "UID=" & varUserName & ";PWD=" & varPassword

    strConnection = "ODBC;Driver=SQL Server;Server=serverip\database;" & varCreds & ";APP=2007 Microsoft Office system;DATABASE=database"

    Dim dbCurrent As DAO.Database
    Dim qdf As DAO.QueryDef
    Dim rst As DAO.Recordset

    Set dbCurrent = DBEngine(0)(0)
    Set qdf = dbCurrent.CreateQueryDef("")

    Dim td As TableDef

    strsql = "SELECT * FROM ActiveTablesToLink WHERE LinkFlag = -1 And DatabaseName = 'database'"

    Set recLocal = CurrentDb.OpenRecordset(strsql)

    recLocal.MoveLast
    recLocal.MoveFirst

    strRecCount = recLocal.RecordCount

    If strRecCount > 0 Then

        Do While Not recLocal.EOF

        stLocalTableName = recLocal!LocalTableName
        stRemoteTableName = recLocal!SSTableName

            Set td = CurrentDb.CreateTableDef(stLocalTableName, dbAttachSavePWD, stRemoteTableName, strConnection)

            CurrentDb.TableDefs.Append td

            recLocal.MoveNext

        Loop

    Else

    End If 'Empty recordset

    recLocal.Close
    Application.RefreshDatabaseWindow

    DoCmd.Close acForm, "Login"

Exit_cmdLogin:                          ' Label to resume after error.
      Exit Sub

Err_Login:
    MsgBox Err.Number & ": " & Err.Description
    Call LogError(Err.Number, Err.Description, "SelectAll()")
    Resume Exit_cmdLogin

End Sub

Вот 4 всплывающих сообщения с неверными учетными данными в порядке их появления:

Error 1

Error 2

Error 3

Error 4

Любая помощь приветствуется.

Ответы [ 2 ]

2 голосов
/ 20 июня 2020

Чтобы проверить пользователя / пароль, используйте QueryDef заранее, чтобы проверить соединение.
Не пытайтесь создать связанную таблицу до этого. 

    ' Create a simple Pass-Through query
    Set qdf = dbCurrent.CreateQueryDef("")
    With qdf
        .Connect = strConnection
        .ReturnsRecords = True
        .Sql = "SELECT GETDATE() AS Test"

        ' Try to connect, this will raise a trappable ODBC error if User/Password are wrong
        On Error Resume Next
        Set rst = .OpenRecordset(dbOpenSnapshot)

        If Err.Number <> 0 Then
            MsgBox "Wrong User/Password."
            ' etc.
        End If
    End With

    On Error GoTo ErrHandler
0 голосов
/ 19 июня 2020

Это вид обработки ошибок, который я бы использовал, чтобы попытаться зафиксировать ошибки обоих приложений 

If DBEngine.Errors.Count > 1 Then
    'ODBC Error
    For Each errany In DBEngine.Errors
        msgbox "ODBCExecute: Err# " & errany.Number & " raised by " _
         & errany.Source & ": " & errany.Description, _
         vbCritical, "cmdExecuteAttached()"
    Next errany
Else  'Access Error
    msgbox "ODBCExecute: Err# " & ERR.Number & " raised by " _
     & ERR.Source & ": " & ERR.Description, _
     vbCritical, "cmdExecuteAttached()"
End If

GoTo Exit_Sub
Resume
...