Vba 使用VB将数据从Excel导入Ms Access
我正在尝试将数据从Excel文件导入Ms Access数据库。 在我的Ms Access数据库中有一个就绪表和一个导入表单,我在其中按下导入按钮(我设计的),然后在我的计算机中选择Excel文件,然后导入数据。 问题是,我的代码仅适用于1张工作表的Excel文件,这意味着如果该文件中有多张工作表,它将无法工作,以下是我编写的代码:Vba 使用VB将数据从Excel导入Ms Access,vba,excel,ms-access,excel-2013,Vba,Excel,Ms Access,Excel 2013,我正在尝试将数据从Excel文件导入Ms Access数据库。 在我的Ms Access数据库中有一个就绪表和一个导入表单,我在其中按下导入按钮(我设计的),然后在我的计算机中选择Excel文件,然后导入数据。 问题是,我的代码仅适用于1张工作表的Excel文件,这意味着如果该文件中有多张工作表,它将无法工作,以下是我编写的代码: Private Sub ImportButton_Click() Dim dlg As FileDialog, strFileName As String Set d
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
注意:“人员”是我将数据导入的表的名称。这可能会对您有所帮助
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
可能存在的副本