我有一个包含大约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
答案 0 :(得分: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
答案 1 :(得分:0)
我认为您可以按如下方式设置错误处理:
On Error Resume Next
然后,如果你在任何一行上出现故障,VBA将跳转到下一行。
我不是百分百肯定这会对你的情况有效,但试一试。