如何在 MS Access 中为 Excel 电子表格导入提供错误处理

Question

我正在尝试导入一大堆 Excel 文件，这些文件以今年迄今为止的客户名称分隔。现在，这些文件包含许多记录，并且每个月的每一天都有不同的工作表。代码的每个单独部分似乎都有效。我之前已经单独测试过。但是，如果当天是周末或节假日，则没有电子表格。我处理了周末。但是 On Error Resume Next 似乎没有正确处理假期。谁能指出我正确的方向？

注意：客户端和路径将被硬编码...原因。无关的消息框用于测试目的。电子表格的命名约定是 _#。如果您知道执行此操作的更好方法，请随时告诉我。

Public Function importer()
Dim file As String, path As String, i As Integer, datevar As Date, month As     Integer, fDate As Variant

path = "path"
file = Dir(path & "*client*")

DoCmd.RunSQL ("DELETE * FROM [table]")


Do While file <> ""


    If file Like "*2018*" Then
        month = GetMonth(file)
        MsgBox (path & file)

        For i = 1 To 31
        If IsDate(month & "/" & i & "/2018") = True Then
        datevar = CDate(month & "/" & i & "/2018")
            If IsDate(datevar) = True And datevar < CDate("8/8/2018") Then
                fDate = Weekday(month & "/" & i & "/2018", vbMonday)
                If fDate < 5 Then
                    On Error Resume Next
                    DoCmd.TransferSpreadsheet acImport, , "table", path & file, True, "_" & i
                End If
             End If
        End If
        Next i

     Else
        MsgBox ("No")
    End If
    file = Dir
Loop


End Function

Public Function GetMonth(file) As Variant
    Dim monthnumberx As Integer
        Select Case True
            Case file Like "*January*"
            monthnumberx = 1
            Case file Like "*February*"
            monthnumberx = 2
            Case file Like "*March*"
            monthnumberx = 3
            Case file Like "*April*"
            monthnumberx = 4
            Case file Like "*May*"
            monthnumberx = 5
            Case file Like "*June*"
            monthnumberx = 6
            Case file Like "*July*"
            monthnumberx = 7
            Case file Like "*August*"
            monthnumberx = 8
            Case file Like "*September*"
            monthnumberx = 9
            Case file Like "*October*"
            monthnumberx = 10
            Case file Like "*November*"
            monthnumberx = 11
            Case file Like "*December*"
            monthnumberx = 12
            End Select
     GetMonth = monthnumberx
End Function

Answer 1

我会将您的importer 程序分成两部分。

1. ProcessExcelFiles 执行您的目录文件循环。
2. ExcelFileImport 导入文件。

然后错误陷阱将记录该单个文件的记录。

我推荐阅读Clean Code，它确实提高了我的编码技能。它涵盖的概念之一是，如果该过程做的事情不止一件，则需要将其拆分为单独的过程。另外，将程序命名为它们所做的事情，例如importer 最好命名为 ExcelFileImport 或在模块中 Excel 作为过程 FileImport。

Public Sub ProcessExcelFiles()
On Error GoTo ErrTrap
Dim file As String, path As String, i As Integer, datevar As Date, month As Integer, fDate As Variant
Dim filePath As String

    path = "path"
    file = Dir(path & "*client*")

    DoCmd.RunSQL ("DELETE * FROM [table]")

    Do While file <> ""
        If file Like "*2018*" Then
            month = GetMonth(file)
            'MsgBox (path & file)

            For i = 1 To 31
                If IsDate(month & "/" & i & "/2018") = True Then
                datevar = CDate(month & "/" & i & "/2018")
                    If IsDate(datevar) = True And datevar < CDate("8/8/2018") Then
                        fDate = Weekday(month & "/" & i & "/2018", vbMonday)
                        If fDate < 5 Then
                            filePath = path & file
                            ExcelFileImport filePath, i
                        End If
                     End If
                End If
            Next i

         Else
            MsgBox ("No")
        End If
        file = Dir
    Loop

ExitProcedure:
    On Error Resume Next
    Exit Sub

ErrTrap:
    Select Case Err.number
        Case Is <> 0
            ErrorLog "MyModule", "ProcessExcelFiles", Err.number, Err.description, file
            Resume ExitProcedure
        Case Else
            Resume ExitProcedure
    End Select

End Sub

Private Sub ExcelFileImport(ByVal filePath As String, ByVal index As Integer)
On Error GoTo ErrTrap

    DoCmd.TransferSpreadsheet acImport, , "table", filePath, True, "_" & index

ExitProcedure:
    On Error Resume Next
    Exit Sub

ErrTrap:
    Select Case Err.number
        Case Is <> 0
            ErrorLog "MyModule", "ExcelFileImport", Err.number, Err.description, filePath
            Resume ExitProcedure
        Case Else
            Resume ExitProcedure
    End Select

End Sub

Private Function GetMonth(ByVal file As String) As Variant
    Dim monthnumberx As Integer
        Select Case True
            Case file Like "*January*"
            monthnumberx = 1
            Case file Like "*February*"
            monthnumberx = 2
            Case file Like "*March*"
            monthnumberx = 3
            Case file Like "*April*"
            monthnumberx = 4
            Case file Like "*May*"
            monthnumberx = 5
            Case file Like "*June*"
            monthnumberx = 6
            Case file Like "*July*"
            monthnumberx = 7
            Case file Like "*August*"
            monthnumberx = 8
            Case file Like "*September*"
            monthnumberx = 9
            Case file Like "*October*"
            monthnumberx = 10
            Case file Like "*November*"
            monthnumberx = 11
            Case file Like "*December*"
            monthnumberx = 12
            End Select
     GetMonth = monthnumberx
End Function

Public Sub ErrorLog( _
  ByVal Module As String _
, ByVal procedure As String _
, ByVal number As Variant _
, ByVal description As String _
, ByVal fileName As String)
On Error GoTo ErrTrap
'--------------------------------------------------------------------------------------------------------------------
' Purpose:  Creates a record of the error
' Example:  ErrorLog "MyModule", "ExcelFileImport", "404", "Error Message Here...", "C:\Temp\test.xlsx"
'--------------------------------------------------------------------------------------------------------------------

    DoCmd.RunSQL ("INSERT INTO [ERROR_LOG] (UserName, ComputerName, ErrorDateTime, ModuleName, ProcedureName, ErrorNumber, ErrorDescription, FilePath) VALUES " _
    & "('" & Environ("UserName") & "', '" & Environ("ComputerName") & "', '" & CStr(Format(Now(), "dd-MMM-yyyy hh:nn:ss AM/PM")) & "', '" & Module & "', '" & procedure & "', '" & CStr(number) & "', '" & description & "', '" & fileName & "');")

ExitProcedure:
    On Error Resume Next
    Exit Sub

ErrTrap:
    Select Case Err.number
        Case Is <> 0
            Resume ExitProcedure
        Case Else
            Resume ExitProcedure
    End Select

End Sub

仅供参考，您必须创建一个 [ERROR_LOG] 表。

CREATE TABLE ERROR_LOG 
(
  UserName Text(255)
, ComputerName Text(255)
, ErrorDateTime Text(255)
, ModuleName Text(255)
, ProcedureName Text(255)
, ErrorNumber Text(255)
, ErrorDescription Text(255)
, FilePath Text(255)
)