excel - 如何在 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程序分为2部分。

ProcessExcelFiles你的目录文件循环。

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

FYI, you'll have to create an [ERROR_LOG] table.

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