当不是所有的Excel文件都具有相同的工作表时，将多个Excel文件和工作表导入到Access
我有一个大约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
我认为你可以设置error handling如下：
On Error Resume Next
那么，如果任何一条线路出现故障，VBA就会跳到下一行。
我不是100％肯定这会在你的情况下工作，但试试看。
参考也： testing或检查表是否存在
考虑这种方法，根据工作表的存在将各个文件保存到各种VBA集合中，然后遍历集合：
Public Function ImportExcelFiles() Dim strpath As String, strFile As String Dim xlApp As Object, xlWkb As Object, xlWks As Object Dim allColl As New Collection Dim surveyColl As New Collection, amphibColl As New Collection Dim birdColl As New Collection, plantColl As New Collection Dim speciesColl As New Collection Dim item As Variant, coll As Variant 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*") Set xlApp = CreateObject("Excel.Application") ' LOOP THROUGH FILES Do While strFile <> "" Set xlWkb = xlApp.Workbooks.Open(strpath & strFile) ' LOOP THROUGH WORKSHEETS For Each xlWks In xlWkb.Worksheets Select Case xlWks.Name Case "SurveyData" surveyColl.Add Array(strpath & strFile, "SurveyData") Case "AmphibianSurveyObservationData" amphibColl.Add Array(strpath & strFile, "AmphibianSurveyObservationData") Case "BirdSurveyObservationData" birdColl.Add Array(strpath & strFile, "BirdSurveyObservationData") Case "PlantObservationData" plantColl.Add Array(strpath & strFile, "PlantObservationData") Case "WildSpeciesObservationData" speciesColl.Add Array(strpath & strFile, "WildSpeciesObservationData") End Select Next xlWks strFile = Dir xlWkb.Close False Loop ' LOOP THROUGH EACH COLLECTION AND IMPORT allColl.Add surveyColl: allColl.Add amphibColl allColl.Add birdColl: allColl.Add plantColl allColl.Add speciesColl For Each coll In allColl For Each item In coll ' ASSUMES WORKSHEETS AND TABLE NAMES ARE SAME DoCmd.TransferSpreadsheet transfertype:=acImport, tablename:=item(1), _ FileName:=item(0), HasFieldNames:=True, Range:=item(1) & "!" Next item Next coll Set xlWks = Nothing Set xlWkb = Nothing Set xlApp = Nothing DoCmd.SetWarnings True MsgBox "All data has been imported.", vbOKOnly End Function
下面的脚本对我来说工作得很好。 只要确保您的字段名称匹配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