VBA - В результате вызова модуля "ожидаемая переменная процедура не является модулем" - PullRequest
0 голосов
/ 29 апреля 2019

правый. Поэтому я решил, что когда я перейду к разделению FE / BE моей базы данных, я хочу использовать ' Обработка ошибок Аллена Брауна в VBA ', поскольку это позволит остановить процесс, сообщить пользователю об этом действии. не удалось и зарегистрируйте ошибку автоматически, чтобы я мог просмотреть ее позже.

Единственная проблема в том, что я получаю сообщение об ошибке «ожидаемая переменная процедура, а не модуль»

Теперь я немного адаптировал код Аллена, поэтому вместо того, чтобы называться «LogError», я изменил все это на «LogAutoErrors»

Это первая подпрограмма, в которую я добавил код вызова, который выдает ошибку выше

Private Sub ImportAttendees_Click()
On Error GoTo ImportAttendees_Click_Err

Dim SelectedFile    As String
Dim FilePicker      As FileDialog
Dim SQLdelete       As String

Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
FilePicker.AllowMultiSelect = False
FilePicker.Filters.Add "Excel", "*.xls*", 1
FilePicker.InitialFileName = "C:\Users\"
FilePicker.Title = "Select New Attendee List Location..."
FilePicker.Show

If FilePicker.SelectedItems.Count <> 0 Then
    SelectedFile = FilePicker.SelectedItems(1)

    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tbl_STG_AttendeeImport", SelectedFile, True

    MsgBox prompt:="Data Staged - Ready For Import", buttons:=vbInformation, Title:="Data Loaded"
End If

Me.Refresh

Exit Sub

ErrorHandler:

ImportAttendees_Click_Err: ' Label to jump to on error.
MsgBox prompt:="E-Link encountered an error when processing the last action. E-Link has cancelled the last action and the error has been logged with the system administrator", buttons:=vbInformation, Title:="Database Process Error"
Call logAutoErrors(Err.Number, Err.Description, "ImportAttendees_Click()")
Resume Exit_ImportAttendees_Click
End Select
End Sub

Ожидаемый результат: всякий раз, когда я получаю ошибки (например, моя любимая ошибка времени выполнения 3061), он вставляется в таблицу ошибок и отменяет действия.

РЕДАКТИРОВАТЬ: Вот исправленный код Аллена Брауна, единственное, что я изменил, было одно имя поля и имя модуля

Function logAutoErrors(ByVal lngErrNumber As Long, ByVal strErrDescription As String, _
    strCallingProc As String, Optional vParameters, Optional bShowUser As Boolean = False) As Boolean
On Error GoTo Err_logAutoErrors
    ' Purpose: Generic error handler.
    ' Logs errors to table "tLogError".
    ' Arguments: lngErrNumber - value of Err.Number
    ' strErrDescription - value of Err.Description
    ' strCallingProc - name of sub|function that generated the error.
    ' vParameters - optional string: List of parameters to record.
    ' bShowUser - optional boolean: If False, suppresses display.
    ' Author: Allen Browne, allen@allenbrowne.com

    Dim strMsg As String      ' String for display in MsgBox
    Dim rst As DAO.Recordset  ' The tLogError table

    Select Case lngErrNumber
    Case 0
        Debug.Print strCallingProc & " called error 0."
    Case 2501                ' Cancelled
        'Do nothing.
    Case 3314, 2101, 2115    ' Can't save.
        If bShowUser Then
            strMsg = "Record cannot be saved at this time." & vbCrLf & _
                "Complete the entry, or press <Esc> to undo."
            MsgBox strMsg, vbExclamation, strCallingProc
        End If
    Case Else
        If bShowUser Then
            strMsg = "Error " & lngErrNumber & ": " & strErrDescription
            MsgBox strMsg, vbExclamation, strCallingProc
        End If
        Set rst = CurrentDb.OpenRecordset("tbl_ADM_ErrorLog", , dbAppendOnly)
        rst.AddNew
            rst![ErrNumber] = lngErrNumber
            rst![ErrDescription] = Left$(strErrDescription, 255)
            rst![ErrDate] = Now()
            rst![CallingProc] = strCallingProc
            rst![UserID] = TempVars!AUID
            If Not IsMissing(vParameters) Then
                rst![Parameters] = Left(vParameters, 255)
            End If
        rst.Update
        rst.Close
        LogError = True
    End Select

Exit_logAutoErrors:
    Set rst = Nothing
    Exit Function

Err_logAutoErrors:
    strMsg = "An unexpected situation arose in your program." & vbCrLf & _
        "Please write down the following details:" & vbCrLf & vbCrLf & _
        "Calling Proc: " & strCallingProc & vbCrLf & _
        "Error Number " & lngErrNumber & vbCrLf & strErrDescription & vbCrLf & vbCrLf & _
        "Unable to record because Error " & Err.Number & vbCrLf & Err.Description
    MsgBox strMsg, vbCritical, "logAutoErrors()"
    Resume Exit_logAutoErrors
End Function

Ответы [ 2 ]

1 голос
/ 29 апреля 2019

Это может произойти, если у вас есть функция или вспомогательное устройство с тем же именем, что и у модуля. Каждое имя должно быть уникальным. Даже модули.

Пример: enter image description here Обратите внимание на модули слева. Вот где ваша проблема будет найдена.

У вас были странные вещи с вашими метками. У вас также был End Select без оператора select.

Попробуйте это:

Private Sub ImportAttendees_Click()
    On Error GoTo ErrorHandler

    Dim SelectedFile    As String
    Dim FilePicker      As FileDialog
    Dim SQLdelete       As String

    Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
    With FilePicker
        .AllowMultiSelect = False
        .Filters.Add "Excel", "*.xls*", 1
        .InitialFileName = "C:\Users\"
        .Title = "Select New Attendee List Location..."
        .Show
    End With

    If FilePicker.SelectedItems.Count <> 0 Then
        SelectedFile = FilePicker.SelectedItems(1)

        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tbl_STG_AttendeeImport", SelectedFile, True

        MsgBox prompt:="Data Staged - Ready For Import", Buttons:=vbInformation, Title:="Data Loaded"
    End If

    Me.Refresh

    Exit Sub

ErrorHandler:

    MsgBox prompt:="E-Link encountered an error when processing the last action. E-Link has cancelled the last action and the error has been logged with the system administrator", Buttons:=vbInformation, Title:="Database Process Error"
    logAutoErrors Err.Number, Err.Description, "ImportAttendees_Click()"
    Resume
End Sub
1 голос
/ 29 апреля 2019

Отсутствует ярлык, Вы должны положить его в нужном месте

этикетка

Resume Exit_ImportAttendees_Click

;

Private Sub ImportAttendees_Click()
On Error GoTo ImportAttendees_Click_Err

Dim SelectedFile    As String
Dim FilePicker      As FileDialog
Dim SQLdelete       As String

Set FilePicker = Application.FileDialog(msoFileDialogFilePicker)
FilePicker.AllowMultiSelect = False
FilePicker.Filters.Add "Excel", "*.xls*", 1
FilePicker.InitialFileName = "C:\Users\"
FilePicker.Title = "Select New Attendee List Location..."
FilePicker.Show

If FilePicker.SelectedItems.Count <> 0 Then
    SelectedFile = FilePicker.SelectedItems(1)

    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, "tbl_STG_AttendeeImport", SelectedFile, True

    MsgBox prompt:="Data Staged - Ready For Import", buttons:=vbInformation, Title:="Data Loaded"
End If
Exit_ImportAttendees_Click:
Me.Refresh

Exit Sub

ErrorHandler:

ImportAttendees_Click_Err: ' Label to jump to on error.
MsgBox prompt:="E-Link encountered an error when processing the last action. E-Link has cancelled the last action and the error has been logged with the system administrator", buttons:=vbInformation, Title:="Database Process Error"
Call logAutoErrors(Err.Number, Err.Description, "ImportAttendees_Click()")
Resume Exit_ImportAttendees_Click
End Select
End Sub
...