VBA for Import Mulitple Worksheets from Same Workbook

[mizzourob]

[Solved] VBA for Import Mulitple Worksheets from Same Workbook

Hello..

I am trying to set up VBA to import a user selected Excel workbook that contains various numbers of variously named worksheets that are all formatted the same. I do not care about the worksheet names, but need to import them all into the same Access table. Each worksheet contains extraneous header information that I cannot remove. Here is the code that I have that works but only does so for the first worksheet in the workbook. I need to get it to iterate through the same cell range in all worksheets in the workbook. My Access table for the data to be loaded into is Import_Temp. Any help would be appreciated.

Private Sub Command0_Click()
Dim fileName As Variant
Dim strFileName As String

Call Application.FileDialog(msoFileDialogOpen).Filters.Clear
'Add a custom filter
Call Application.FileDialog(msoFileDialogOpen).Filters.Add( _
"Excel XLSX Files Only", "*.xlsx")
Set fileName = Application.FileDialog(msoFileDialogOpen)
If fileName.Show Then
strFileName = fileName.SelectedItems(1)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, "Import_Temp", strFileName, True, "A3:V66"
End If
End Sub

 

[Ranman256]

I run a macro in my personal workbook,
it strips the bad top rows, leaves the fieldnames at top row,
then saves the excel file to the same name everytime, File2Import.xls. (so I keep the original intact)

Then access has every sheet in this workbook linked in as tables.
then simply run the access macro to run append queries. (thus importing the data)

 

[mizzourob]

Ok I figured it out... here is my solution. I had to split it into two function as found on StackOverflow (sorry post count not high enough to share link).

Private Sub Command0_Click()
' Requires reference to Microsoft Office 11.0 Object Library.
Dim fDialog As FileDialog
Dim varFile As Variant
' Clear listbox contents.
'Me.FileList.RowSource = ""
' Set up the File Dialog.
Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
With fDialog
.AllowMultiSelect = False
.Filters.Add "Excel File", "*.xls"
.Filters.Add "Excel File", "*.xlsx"
If .Show = True Then
'Loop through each file selected and add it to our list box.
For Each varFile In .SelectedItems
' Label3.Caption = varFile
Const acImport = 0
Const acSpreadsheetTypeExcel9 = 8
''This gets the sheets to new tables
GetSheets varFile
Next
MsgBox ("Import data successful!")
End If
End With
End Sub

Sub GetSheets(strFileName)
'Requires reference to the Microsoft Excel x.x Object Library
Dim objXL As New Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Object
'objXL.Visible = True
Set wkb = objXL.Workbooks.Open(strFileName)
For Each wks In wkb.Worksheets
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
"Import_Temp", strFileName, True, wks.Name & "!A3:V66"
Next
'Tidy up
wkb.Close
Set wkb = Nothing
objXL.Quit
Set objXL = Nothing
End Sub