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

Question

我正在尝试导入一大堆以客户端名称分隔的 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

Answer 1

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

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

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

我建议阅读干净的代码，它确实提高了我的编码技能。它涵盖的概念之一是，如果过程执行多个操作，则需要将其拆分为单独的过程。此外，将程序命名为它们的作用，例如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:Temptest.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)
)