This code will run when user clicks the button, btnImportXL.
it opens applet to pick file,
then opens the excel file to get all the sheet names,
closes the file
imports all sheets
Code:
'user clicks import button
btnImportXL_click()
vFile = UserPick1File ("c:\folder\")
if vFile <> "" then ImportAllFilesAndSheets1File vFile
end sub
'-----------------
Public Function UserPick1File(Optional pvPath)
'-----------------
Dim strTable As String
Dim strFilePath As String
Dim sDialog As String, sDecr As String, sExt As String
'===================
'YOU MUST ADD REFERENCE : Microsoft Office 11.0 Object Library, in vbe menu, TOOLS, REFERENCES
'===================
With Application.FileDialog(msoFileDialogFilePicker)
.AllowMultiSelect = False
.Title = "Locate a file to Import"
.ButtonName = "Import"
.Filters.Clear
.Filters.Add "Excel Files", "*.xls;*.xlsx"
.Filters.Add "All Files", "*.*"
.InitialFileName = pvPath
.InitialView = msoFileDialogViewList 'msoFileDialogViewThumbnail
If .Show = 0 Then
'There is a problem
Exit Function
End If
'Save the first file selected
UserPick1File = Trim(.SelectedItems(1))
End With
End Function
'-----------------
Public Sub ImportAllFilesAndSheets1File (ByVal pvFile)
'-----------------
Dim vFil, vTargT
Dim i As Integer
Dim sTbl As String, sSql As String
Dim fso
Dim oFolder, oFile
Dim colTabs As Collection
On Error GoTo errImp
If Right(pvDir, 1) <> "\" Then pvDir = pvDir & "\"
sTbl = "xlFile"
'=========== YOU MUST HAVE 'EXCEL OBJECT LIBRARY' loaded via VBE menu, TOOLS, REFERENCES
'msgbox YOU MUST HAVE 'EXCEL OBJECT LIBRARY' loaded ", , "DELETE THIS MsgBox"
Set colTabs = getAllTabsInWB(pvFile)
For Each vSheet In colTabs
'IMPORT THE WORKBOOK via sheet
DoCmd.TransferSpreadsheet acImport, vSheet, pvFile, True, vSheet
Next
End If
Set colTabs = Nothing
DoCmd.SetWarnings True
Exit Sub
errImp:
MsgBox Err.Description, vbCritical, "clsImport:ImportData()" & Err
Exit Sub
Resume
End Sub
'-----------------
Private Function getAllTabsInWB(ByVal pvFile) As Collection
'-----------------
Dim sht As Worksheet
Dim col As New Collection
Dim xl As excel.Application
'=========== YOU MUST HAVE 'EXCEL OBJECT LIBRARY' loaded via VBE menu, TOOLS, REFERENCES
Set xl = CreateObject("excel.application")
With xl
.Workbooks.Open pvFile
For Each sht In xl.Sheets
col.Add sht.Name
Next
.ActiveWorkbook.Close False
End With
Set getAllTabsInWB = col
Set xl = Nothing
End Function