CODEWITHSUNDEEP
excelvbams-access
BlimBlomBlum
BlimBlomBlum

Reputation: 397

Import multiple sheets from workbook

I've adapted this post to import multiple Excel sheets into multiple tables using VBA in Access from a single Excel file.

It creates the new tables, names them correctly, uses the range specified, closes the workbook after.... but each new Access table has the same contents (from worksheet 1)!

ie NewTable1 and NewTable2 both contain contents of Worksheet1 despite having different names. It seems like the code is working so I don't know why this error keeps happening. Any help is appreciated.

My edited code, adapted from linked post:

Function ImportData()
   ' 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(3)

   With fDialog

      .AllowMultiSelect = False
      .Filters.Add "Excel File", "*.xlsx"
    .Filters.Add "Excel File", "*.xls"

      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 acSpreadsheetTypeExcel12Xml = 10

         ''This gets the sheets to new tables
         GetSheets varFile

         Next
         MsgBox ("Import data successful!")
         End If
End With
End Function


Function 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
        'MsgBox wks.Name
        Set TableName = wks.Cells(10, "B")
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, _
        TableName, strFileName, True, "14:150"
    Next

   'Tidy up
   objXL.DisplayAlerts = False
   wkb.Close
   Set wkb = Nothing
   objXL.Quit
   Set objXL = Nothing

End Function

Upvotes: 1

Views: 730

Answers (2)

June7
June7

Reputation: 21370

DoCmd.TransferSpreadsheet just pulls from first worksheet unless specify otherwise. Instead of "14:150", use:

wks.Name & "$14:150"

or

wks.Name & "!14:150"

Or use wks.CodeName to pull the sheet index instead of name in case there are issues with name construct.

Without a range reference, the $ character would be needed.

Upvotes: 1

Ultra Junkie
Ultra Junkie

Reputation: 164

Alternatively, use a string variable like

 Dim strRange as string

 strRange = "sheetname!14:150"

and then

 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, _
    TableName, strFileName, True, stRrange

Upvotes: 0

Related Questions