使用VB将数据从Excel导入Ms Access

Question

我正在尝试将 Excel 文件中的数据导入我的 Ms Access 数据库。 我的 Ms Access 数据库中有一个现成的表和一个导入表单，我在其中按下导入按钮（我设计的），然后在我的计算机中选择 Excel 文件并导入数据。 问题是我的代码仅适用于 1 张 Excel 文件，这意味着如果文件中有多个表格，它就不起作用，这是我编写的代码：

Private Sub ImportButton_Click()
Dim dlg As FileDialog, strFileName As String
Set dlg = Application.FileDialog(msoFileDialogFilePicker)
With dlg
.Title = "Select the Excel file to import"
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Excel Files", "*.xls*", 1
.Filters.Add "All Files", "*.*",  
If .Show = -1 Then
strFileName = .SelectedItems(1)
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, "Personnel", strFileName, True
Else
Exit Sub
End If
End With
End Sub

那么有没有一种方法可以让我一个一个地循环遍历 Excel 文件中的工作表？ 提前致谢。 更新： 如果有人需要，这是新的工作代码。

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

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

End Su

b

注意：“Personnel”是我要向其中导入数据的表的名称。

Answer 1

这可能对你有帮助

Option Explicit

Sub AccImport()
    Dim acc As New Access.Application
    acc.OpenCurrentDatabase "C:\Users\Public\Database1.accdb"
    acc.DoCmd.TransferSpreadsheet _
            TransferType:=acImport, _
            SpreadSheetType:=acSpreadsheetTypeExcel12Xml, _
            TableName:="tblExcelImport", _
            Filename:=Application.ActiveWorkbook.FullName, _
            HasFieldNames:=True, _
            Range:="Folio_Data_original$A1:B10"
    acc.CloseCurrentDatabase
    acc.Quit
    Set acc = Nothing
End Sub

Link to question