从工作簿导入多张工作表

Question

我已经调整了这个post 以使用 Access 中的 VBA 从单个 Excel 文件将多个 Excel 工作表导入到多个表中。

它创建新表，正确命名它们，使用指定的范围，然后关闭工作簿...... 但每个新的 Access 表都有相同的内容（来自工作表 1）！

即 NewTable1 和 NewTable2 都包含 Worksheet1 的内容，尽管它们的名称不同。看起来代码正在运行，所以我不知道为什么这个错误不断发生。任何帮助表示赞赏。

我编辑的代码，改编自链接的帖子：

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

Answer 1

除非另有说明，否则 DoCmd.TransferSpreadsheet 只会从第一个工作表中提取。代替"14:150"，使用：

wks.Name & "$14:150"

或

wks.Name & "!14:150"

或者使用 wks.CodeName 来提取工作表索引而不是名称，以防名称构造出现问题。

如果没有范围引用，则需要 $ 字符。

Answer 2

或者，使用类似的字符串变量

 Dim strRange as string

 strRange = "sheetname!14:150"

然后

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