Question

我有一个包含大约75个Excel文件（.xlsx）的文件夹。 Excel文件应该都有五个命名的工作表（例如：SurveyData，AmphibianSurveyObservationData，BirdSurveyObservationData，PlantObservationData和WildSpeciesObservationData）。遗憾的是，有时Excel文件只有工作表的一个子集（即，一个Excel文件可能包含所有五个工作表，而另一个只有SurveyData和AmphibianSurveyObservationData工作表。

我想将所有这些Excel文件导入Access，并将每个工作表中的信息放入单独的表中。例如，我希望将所有Excel文件中SurveyData工作表中的所有数据放入名为SurveyData的访问表中。我找到了这个VBA代码（见下文），当Excel文件中存在所有工作表时似乎工作正常，但是当缺少一个工作表时，脚本会停止并且不会继续导入任何其他文件。有没有办法只导入工作表，如果它存在于Excel文件中，否则只是跳过导入？

Function ImportExcelFiles()
Dim strFile As String

    DoCmd.SetWarnings False

    '   Set file directory for files to be imported
    strPath = "D:\SpeciesData\MoELoadform\2015SpeciesDetectionLoadforms - Copy\"
    '   Tell it to import all Excel files from the file directory
    strFile = Dir(strPath & "*.xls*")

    '   Start loop
    Do While strFile <> ""
        ' Import file
        DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:="SurveyData", FileName:=strPath & strFile, HasFieldNames:=True, Range:="SurveyData!A1:AD"
        DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:="AmphibianSurveyObservationData", FileName:=strPath & strFile, HasFieldNames:=True, Range:="AmphibianSurveyObservationData!A1:AQ"
        DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:="BirdSurveyObservationData", FileName:=strPath & strFile, HasFieldNames:=True, Range:="BirdSurveyObservationData!A1:AQ"
        DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:="PlantObservationData", FileName:=strPath & strFile, HasFieldNames:=True, Range:="PlantObservationData!A1:BS"
        DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:="WildSpeciesObservationData", FileName:=strPath & strFile, HasFieldNames:=True, Range:="WildSpeciesObservationData!A1:AP"
    ' Loop to next file in directory
        strFile = Dir
    Loop

    MsgBox "All data has been imported.", vbOKOnly
    End Function

Answer 1

以下脚本对我来说很好。只需确保Excel标题和Access字段名称之间的字段名称匹配。

Option Compare Database

Private Sub Command0_Click()

Dim strPathFile As String, strFile As String, strPath As String
Dim blnHasFieldNames As Boolean
Dim intWorksheets As Integer

' Replace 3 with the number of worksheets to be imported
' from each EXCEL file
Dim strWorksheets(1 To 5) As String

' Replace 3 with the number of worksheets to be imported
' from each EXCEL file (this code assumes that each worksheet
' with the same name is being imported into a separate table
' for that specific worksheet name)
Dim strTables(1 To 5) As String

' Replace generic worksheet names with the real worksheet names;
' add / delete code lines so that there is one code line for
' each worksheet that is to be imported from each workbook file
strWorksheets(1) = "SurveyData"
strWorksheets(2) = "AmphibianSurveyObservationData"
strWorksheets(3) = "BirdSurveyObservationData"
strWorksheets(4) = "PlantObservationData"
strWorksheets(5) = "WildSpeciesObservationData"

' Replace generic table names with the real table names;
' add / delete code lines so that there is one code line for
' each worksheet that is to be imported from each workbook file
strTables(1) = "SurveyData"
strTables(2) = "AmphibianSurveyObservationData"
strTables(3) = "BirdSurveyObservationData"
strTables(4) = "PlantObservationData"
strTables(5) = "WildSpeciesObservationData"

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True

' Replace C:\Documents\ with the real path to the folder that
' contains the EXCEL files
strPath = "C:\Users\xxx\Desktop\All_Excel_Files\"

' Replace 3 with the number of worksheets to be imported
' from each EXCEL file
For intWorksheets = 1 To 5
On Error Resume Next
      strFile = Dir(strPath & "*.xlsx")
      Do While Len(strFile) > 0
            strPathFile = strPath & strFile
            DoCmd.TransferSpreadsheet acImport, _
                  acSpreadsheetTypeExcel9, strTables(intWorksheets), _
                  strPathFile, blnHasFieldNames, _
                  strWorksheets(intWorksheets) & "$"
            strFile = Dir()
      Loop

Next intWorksheets

End Sub

Answer 2

我认为您可以按如下方式设置错误处理：

On Error Resume Next

然后，如果你在任何一行上出现故障，VBA将跳转到下一行。

我不是百分百肯定这会对你的情况有效，但试一试。

也参考：Test or check if sheet exists

当并非所有Excel文件具有相同的工作表时，将多个Excel文件和工作表导入Access

2 个答案: