從Excel導入數據到Ms Access使用VB

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

注：「人事」就是在那裏我將數據導入到表的名稱。

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