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'/ P>

注意：“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

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

1 个答案: