this may help, submit the folder where all the excel books are then it will import them all.
This assumes all sheets in all workbooks are formated the same for import.
Paste this code into a new module, Ctl-F11, new module, then paste, then save.
you must inbed the REFERENCE to excel, VBE menu: tools , references, Microsoft Excel x.x object
submit your folder to the routine below:
usage:
ImportAllSheetsAllFiles1Dir "c:\temp"
Code:
Public mXL As excel.Application
'--------------
Public Sub ImportAllSheetsAllFiles1Dir(ByVal pvDir)
'--------------
Dim vFil, vTargT
Dim i As Integer
Dim sTbl As String, sSql As String
Dim FSO, vSht
Dim oFolder, oFile
Dim colSheets As New Collection
On Error GoTo errImp
Set mXL = CreateObject("excel.application") 'start excel instance
If Right(pvDir, 1) <> "\" Then pvDir = pvDir & "\"
sTbl = "tData"
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = FSO.GetFolder(pvDir)
For Each oFile In oFolder.Files
If InStr(oFile.Name, ".xls") Then
vFil = pvDir & oFile.Name
Set colSheets = getSheetNames(vFil) 'get all sheets in workbook
'import all sheets
For Each vSht In colSheets
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, sTbl, vFil, True, vSht
'debug.print vSht & vbTab & vFil
Next
End If
Next
mXL.Quit
Set FSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
Set mXL = Nothing
Exit Sub
errImp:
MsgBox Err.Description, vbCritical, "clsImport:ImportData()" & Err
Exit Sub
Resume
End Sub
Public Function getSheetNames(ByVal pvFile) As Collection
Dim col As New Collection
Dim sht
On Error GoTo errSht
With mXL
.Workbooks.Open pvFile
For Each sht In .Worksheets
col.Add sht.Name
Next
End With
endit:
mXL.ActiveWorkbook.Close False
Set getSheetNames = col
Exit Function
errSht:
MsgBox Err.Description, , "getSheetNames():" & Err
return Endit
End Function