如何通过VBA将包含多个工作表的一个Excel文件导入到访问表中

Steve 发表于 Dev

史蒂夫

我必须通过vba将一个包含多个工作表的excel文件导入到访问表中，但是下面列出的当前代码将仅复制excel的第一工作表记录并导入到访问表中，所有工作表的格式和布局都相同。如何使我的代码复制所有工作表的记录并导入到Access表中。请随时回答问题，并感谢您的回答。

 Private Sub Command9_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
                    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
    "Plymouth - Nominal Detail", varFile, True

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


End Sub

菲奥努阿拉

您需要指定工作表，例如：

Private Sub Command9_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, _
            wks.Name, strFileName, True, wks.Name & "$"
   Next

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

End Sub