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

How to import one excel file that contain multiple worksheets into an access table by vba

提问by Steve

I have to import one excel file that contain multiple worksheets into an access table by vba, but my current code listed below will only copy the first worksheet record of the excel and import into an access table, all the worksheets got same format and layout. how to enable my code to copy all the worksheets' records and import into a table in access. Please feel free to answer the question and thanks for any answer.

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

 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

回答by Fionnuala

You need to specify the sheets, for example:

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

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

回答by Johnny Bones

If you need to do it generically, which is probably what you're asking, this code will work. Just remember to edit it where obvious:

如果您需要一般地执行此操作，这可能就是您所要求的，此代码将起作用。只要记住在明显的地方编辑它：

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile As String
Dim strPassword As String

' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
      Set objExcel = CreateObject("Excel.Application")
      blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False

' Replace C:\Filename.xls with the actual path and filename
strPathFile = "C:\Filename.xls"

' Replace passwordtext with the real password;
' if there is no password, replace it with vbNullString constant
' (e.g., strPassword = vbNullString)
strPassword = "passwordtext"

blnReadOnly = True ' open EXCEL file in read-only mode

' Open the EXCEL file and read the worksheet names into a collection
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
      strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
      colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
            "tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, _
            colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

' Uncomment out the next code step if you want to delete the 
' EXCEL file after it's been imported
' Kill strPathFile

If you want to import them all into the same table, try this (just remember to set up all the tabs exactly the same or it will probably fail):

如果要将它们全部导入同一个表，请尝试此操作（请记住将所有选项卡设置为完全相同，否则可能会失败）：

Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPathFile as String, strTable as String
Dim strPassword As String

' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
      Set objExcel = CreateObject("Excel.Application")
      blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = False

' Replace C:\Filename.xls with the actual path and filename
strPathFile = "C:\Filename.xls"

' Replace tablename with the real name of the table into which 
' the data are to be imported
strTable = "tablename"

' Replace passwordtext with the real password;
' if there is no password, replace it with vbNullString constant
' (e.g., strPassword = vbNullString)
strPassword = "passwordtext"

blnReadOnly = True ' open EXCEL file in read-only mode

' Open the EXCEL file and read the worksheet names into a collection
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _
      strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
      colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into the table
For lngCount = colWorksheets.Count To 1 Step -1
      DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
            strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

' Uncomment out the next code step if you want to delete the 
' EXCEL file after it's been imported
' Kill strPathFile

回答by Scott_NYC

TransferSpreadsheetaccepts an Excel data Rangeas one of its optional parameters.

TransferSpreadsheet接受 Excel 数据范围作为其可选参数之一。

docmd.TransferSpreadsheet(TransferType, SpreadsheetType, TableName, FileName, HasFieldNames, Range, UseOA)

Normally a range in Excel is defined in terms of a sheet name and cell range, but in this case the method will accept "Sheetname!" (i.e. the name of the sheet followed by an exclamation point.

通常，Excel 中的范围是根据工作表名称和单元格范围定义的，但在这种情况下，该方法将接受“Sheetname！” （即工作表的名称后跟一个感叹号。

So if you know the name of the sheets, the following sequence of commands works...

因此，如果您知道工作表的名称，则以下命令序列有效...

DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
    "Plymouth - Nominal Detail", varFile, True, Range = "FirstSheetNameHere!"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
    "Plymouth - Nominal Detail", varFile, True, Range = "SecondSheetNameHere!"
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
    "Plymouth - Nominal Detail", varFile, True, Range = "ThirdSheetNameHere!"