将Excel文件的所有表格都导入到Access

Option Compare Database

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