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

我正在尝试导入一大堆Excel文件，这些文件由今年迄今为止的客户名称分隔开。现在，这些文件包含许多记录，每个月的每一天都有不同的工作表。代码的每个单独部分似乎都能工作。我以前单独测试过。但是，如果一天是周末或假日，则没有电子表格。我处理周末的事。但是下一个错误的恢复似乎没有正确处理假期。有人能给我指一下正确的方向吗

注意：由于…原因，客户端和路径将被硬编码。无关消息框用于测试目的。电子表格的命名约定为。如果你知道更好的方法，请随时告诉我

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

我会把你们的进口商程序分成两部分

ProcessExcelFiles执行目录文件循环。 导入文件的ExcelFileImport。 然后错误陷阱将记录该单个文件的记录

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

---

谢谢你的推荐书。我的主要工作不是作为一名开发人员，我只是为了更高效地编写脚本。但是我被要求越来越多地做这件事，所以也许我应该学会正确地做这件事。结果证明这不太管用。所以基本上，当它循环通过时，它跨越了2月19日，一个假期，并且打破了密码。表中未记录任何错误，并且不会继续。您可以发布要测试的文件名列表吗？抱歉，我刚刚注意到我没有错误捕获GetMonth函数。

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

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)
)