Need Help Importing 4 Different Excel Files With The Same Format to Access

[anoble1]

I have a button in my database that when you hit tit, it imports just 1 excel sheet and puts it in a table. Works great. I am wanting to grab 4 more excel sheets from different locations and store them in the same table.
Here is my code.
I pasted my code in a .txt file so it can be easily read.
Thanks!!

Private Sub Command35_Click()
On Error GoTo Err_Command0_Click
    Dim appExcel As Object
    Dim workBook As Object
    Dim workSheet As Object
    Dim i As Integer
    Dim FdrID As Integer
    Dim dbs_curr As Database
    Dim records As Recordset
    Dim sqlStatement As String
    Dim message As String
    Set dbs_curr = CurrentDb
 
 
    ' Open an existing spreadsheet
      Set appExcel = GetObject("S:\Workgroups\file1.xls (This one works)
      GetObject ("S:\Workgroups\file2.xls (This one doesnt work currently)
      GetObject ("S:\Workgroups\File3.xls (This one doesnt work currently)
 
    ' Don't show spreadsheet on screen
      appExcel.Application.Visible = False
 
    Set workSheet = appExcel.Worksheets(1)
 
    i = 2
    While workSheet.Cells.Range("A" & i & ":A" & i).Value <> ""
        sqlStatement = "SELECT GetData.* FROM GetData WHERE PDArea IS NULL"
        Set records = dbs_curr.OpenRecordset(sqlStatement, dbOpenDynaset, dbSeeChanges, dbOptimistic)
        records.AddNew
        records!PDArea = workSheet.Cells.Range("A" & i & ":A" & i).Value
        records!Company = workSheet.Cells.Range("B" & i & ":B" & i).Value
        records!Supervisor = workSheet.Cells.Range("C" & i & ":C" & i).Value
        records!GF = workSheet.Cells.Range("D" & i & ":D" & i).Value
        records!Foreman = workSheet.Cells.Range("E" & i & ":E" & i).Value
        records!current = workSheet.Cells.Range("F" & i & ":F" & i).Value
        records!ReportedIllnesses = workSheet.Cells.Range("G" & i & ":G" & i).Value
        records!Sick = workSheet.Cells.Range("H" & i & ":H" & i).Value
        records!Date = workSheet.Cells.Range("I" & i & ":I" & i).Value
        records.Update
 
        i = i + 1
    Wend
 
 
    ' Release objects
    Set workSheet = Nothing
    Set workBook = Nothing
    Set appExcel = Nothing
 
    MsgBox "Done"
 
Exit_Command0_Click:
    Exit Sub
 
Err_Command0_Click:
    MsgBox Err.Description
    Resume Exit_Command0_Click
 
End Sub

[Megalog]

Here's a quick way to implement this.. All you have to do is create a table called tblExcelSources , and give it one field named 'Filename'.
Store the full paths of the excel files in that table, and then call the function below. This will loop through all the records in the new table, running your excel import for each one.

Back up your data before doing this!

Also, please use the code tags when posting any follow-up scripts.

Private Sub ExcelImport()
    Dim appExcel As Object
    Dim workBook As Object
    Dim workSheet As Object
    Dim i As Integer
    Dim FdrID As Integer
    Dim dbs_curr As Database
    Dim records As Recordset
    Dim sqlStatement As String
    Dim message As String
    Dim rsImport As DAO.Recordset
 
   On Error GoTo ExcelImport_Error
 
    Set dbs_curr = CurrentDB
 
    Set rsImport = CurrentDB.OpenRecordset("tblExcelSources", dbOpenSnapshot)
 
    ' Loop through excel filepaths stored in the table 'tblExcelSources'
    Do While Not rsImport.EOF
        rsImport.MoveFirst
 
        Do While Not rsImport.EOF
            ' Open an existing spreadsheet (full file path stored in tblExcelSources.FileName)
            Set appExcel = GetObject(rsImport!Filename)
 
            ' Don't show spreadsheet on screen
            appExcel.Application.visible = False
 
            Set workSheet = appExcel.Worksheets(1)
 
            i = 2
            While workSheet.Cells.Range("A" & i & ":A" & i).Value <> ""
                sqlStatement = "SELECT GetData.* FROM GetData WHERE PDArea IS NULL"
                Set records = dbs_curr.OpenRecordset(sqlStatement, dbOpenDynaset, dbSeeChanges, dbOptimistic)
                records.AddNew
                records!PDArea = workSheet.Cells.Range("A" & i & ":A" & i).Value
                records!Company = workSheet.Cells.Range("B" & i & ":B" & i).Value
                records!Supervisor = workSheet.Cells.Range("C" & i & ":C" & i).Value
                records!GF = workSheet.Cells.Range("D" & i & ":D" & i).Value
                records!Foreman = workSheet.Cells.Range("E" & i & ":E" & i).Value
                records!Current = workSheet.Cells.Range("F" & i & ":F" & i).Value
                records!ReportedIllnesses = workSheet.Cells.Range("G" & i & ":G" & i).Value
                records!Sick = workSheet.Cells.Range("H" & i & ":H" & i).Value
                records!Date = workSheet.Cells.Range("I" & i & ":I" & i).Value
                records.Update
 
                i = i + 1
            Wend
 
            ' Release objects
            Set workSheet = Nothing
            Set workBook = Nothing
            Set appExcel = Nothing
 
            rsImport.MoveNext
        Loop
    Loop
    Set rsImport = Nothing
    MsgBox "Done"
 
   On Error GoTo 0
   Exit Sub
 
ExcelImport_Error:
 
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ExcelImport()"
 
End Sub

[ADezii]

If you do not wish to store the Absolute Paths to the Excel Files internally for whatever reasons (accidental deletion, syntax error on Absolute Paths, etc.), you can Open an Office Dialog Box, then process the File(s) selected. This would be an excellent choice if the Files existed in the same location, but can still be used singularly:

'First, set a Reference to the Microsoft Office XX.X Object Library
 
Dim strButtonCaption As String
Dim strDialogTitle As String
Dim varItem As Variant
 
'Define your own Captions if necessary
strButtonCaption = "Select .xls"
strDialogTitle = "Select Files to Process"
 
With Application.FileDialog(msoFileDialogFilePicker)
  With .Filters
    .Clear
    .Add "Excel Woorkboks", "*.xls"     'Allow only Excel Files
  End With
  'The Show Method returns True if 1 or more files are selected
    .AllowMultiSelect = True       'Critical Line
    .FilterIndex = 1
    .ButtonName = strButtonCaption
    .InitialFileName = vbNullString
    .InitialView = msoFileDialogViewSmallIcons
    .Title = strDialogTitle
  If .Show Then
    For Each varItem In .SelectedItems
      'Process varItem which will contain the Absolute Path to the .xls
      '...
    Next varItem
  End If
End With