Import multiple Excel file and worksheets to Access, when not all Excel files have the same sheets

Question

I have a folder with about 75 Excel files (.xlsx). The Excel files should all have five named worksheets (for example: SurveyData, AmphibianSurveyObservationData, BirdSurveyObservationData, PlantObservationData, and WildSpeciesObservationData). Unfortunately, sometimes the Excel files have only a subset of the worksheets (i.e., One Excel file might have all five worksheets, while another would only have the SurveyData and AmphibianSurveyObservationData worksheets).

I would like to import all these Excel files into Access and have information from each worksheet put into a separate table. For example, I want all the data from the SurveyData worksheet in all the Excel files to be put into an Access Table called SurveyData. I found this VBA code (see below) and it seems to work fine when all the worksheets are present in the Excel file, but when one worksheet is missing, the script stops and doesn't continue importing any of the other files. Is there any way to only import a worksheet if it's present in the Excel file, otherwise just skip over the import?

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

Consider this approach that saves individual files into various VBA collections according to the existence of worksheets and then iterates through collections:

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

Answer 2

The below script worked fine for me. Just make sure your field names match between the Excel headers and the Access field names.

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 3

I think you can just set the error handling as follows:

On Error Resume Next

Then, if you get a failure on any one line, VBA will just jump to the next line.

I'm not 100% sure this will work in your case, but give it a try.

reference also: Test or check if sheet exists