如何将一个包含多个工作表的excel文件通过vba导入到访问表中
我必须将一个包含多个工作表的excel文件导入到vba的访问表中，但是我下面列出的当前代码只会复制excel的第一个工作表logging并导入到访问表中，所有的工作表都具有相同的格式和布局。 如何使我的代码复制所有工作表的logging，并导入到访问表中。 请随时回答这个问题，谢谢你的回答。
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 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ "Plymouth - Nominal Detail", varFile, True Next MsgBox ("Import data successful!") End If End With End Sub 您需要指定图纸，例如：
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 xx 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
如果你需要一般的做，这可能是你问的，这个代码将工作。 只要记住在显而易见的地方编辑它：
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean Dim lngCount As Long Dim objExcel As Object, objWorkbook As Object Dim colWorksheets As Collection Dim strPathFile As String Dim strPassword As String ' Establish an EXCEL application object On Error Resume Next Set objExcel = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set objExcel = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 ' Change this next line to True if the first row in EXCEL worksheet ' has field names blnHasFieldNames = False ' Replace C:\Filename.xls with the actual path and filename strPathFile = "C:\Filename.xls" ' Replace passwordtext with the real password; ' if there is no password, replace it with vbNullString constant ' (eg, strPassword = vbNullString) strPassword = "passwordtext" blnReadOnly = True ' open EXCEL file in read-only mode ' Open the EXCEL file and read the worksheet names into a collection Set colWorksheets = New Collection Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _ strPassword) For lngCount = 1 To objWorkbook.Worksheets.Count colWorksheets.Add objWorkbook.Worksheets(lngCount).Name Next lngCount ' Close the EXCEL file without saving the file, and clean up the EXCEL objects objWorkbook.Close False Set objWorkbook = Nothing If blnEXCEL = True Then objExcel.Quit Set objExcel = Nothing ' Import the data from each worksheet into a separate table For lngCount = colWorksheets.Count To 1 Step -1 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ "tbl" & colWorksheets(lngCount), strPathFile, blnHasFieldNames, _ colWorksheets(lngCount) & "$" Next lngCount ' Delete the collection Set colWorksheets = Nothing ' Uncomment out the next code step if you want to delete the ' EXCEL file after it's been imported ' Kill strPathFile
如果你想把它们全部导入到同一张表中 ，试试这个（只记得设置所有的标签完全相同，否则可能会失败）：
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean Dim lngCount As Long Dim objExcel As Object, objWorkbook As Object Dim colWorksheets As Collection Dim strPathFile as String, strTable as String Dim strPassword As String ' Establish an EXCEL application object On Error Resume Next Set objExcel = GetObject(, "Excel.Application") If Err.Number <> 0 Then Set objExcel = CreateObject("Excel.Application") blnEXCEL = True End If Err.Clear On Error GoTo 0 ' Change this next line to True if the first row in EXCEL worksheet ' has field names blnHasFieldNames = False ' Replace C:\Filename.xls with the actual path and filename strPathFile = "C:\Filename.xls" ' Replace tablename with the real name of the table into which ' the data are to be imported strTable = "tablename" ' Replace passwordtext with the real password; ' if there is no password, replace it with vbNullString constant ' (eg, strPassword = vbNullString) strPassword = "passwordtext" blnReadOnly = True ' open EXCEL file in read-only mode ' Open the EXCEL file and read the worksheet names into a collection Set colWorksheets = New Collection Set objWorkbook = objExcel.Workbooks.Open(strPathFile, , blnReadOnly, , _ strPassword) For lngCount = 1 To objWorkbook.Worksheets.Count colWorksheets.Add objWorkbook.Worksheets(lngCount).Name Next lngCount ' Close the EXCEL file without saving the file, and clean up the EXCEL objects objWorkbook.Close False Set objWorkbook = Nothing If blnEXCEL = True Then objExcel.Quit Set objExcel = Nothing ' Import the data from each worksheet into the table For lngCount = colWorksheets.Count To 1 Step -1 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ strTable, strPathFile, blnHasFieldNames, colWorksheets(lngCount) & "$" Next lngCount ' Delete the collection Set colWorksheets = Nothing ' Uncomment out the next code step if you want to delete the ' EXCEL file after it's been imported ' Kill strPathFile
TransferSpreadsheet接受Excel数据范围作为其可选参数之一。
docmd.TransferSpreadsheet(TransferType, SpreadsheetType, TableName, FileName, HasFieldNames, Range, UseOA)
通常，Excel中的范围是根据工作表名称和单元格范围定义的，但在这种情况下，该方法将接受“工作表名称！” （即表单名称后面跟着感叹号。
所以，如果你知道工作表的名字，下面的命令序列工作…
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ "Plymouth - Nominal Detail", varFile, True, Range = "FirstSheetNameHere!" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ "Plymouth - Nominal Detail", varFile, True, Range = "SecondSheetNameHere!" DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ "Plymouth - Nominal Detail", varFile, True, Range = "ThirdSheetNameHere!"