将一个工作表从多个 Excel 文件导入到 Multiple Access 表中

Question

我有大约 200 个 Excel 文件，我想将它们导入到单个 Access 数据库中，并且每个文件都有一个表。每个 Excel 文件都有多个工作表，但我要导入的工作表是一致的。

我为此找到了一些代码，请参阅：http://www.accessmvp.com/KDSnell/EXCEL_Import.htm#ImpBrsFldFiles， http://social.msdn.microsoft.com/Forums/en-US/dfea25ab-cd49-495c-8096-e3a7a1484f65/importing-multiple-excel-files-with-different-file-name-into-access-using-vba

这是我尝试过的一段代码：

Option Compare Database

Sub ImportFromExcel()

End Sub

Dim strPathFile As String, strFile As String, strPath As String
Dim strTable As String, strBrowseMsg As String
Dim blnHasFieldNames As Boolean
    ' Change this next line to True if the first row in EXCEL worksheet
    ' has field names
blnHasFieldNames = True

strBrowseMsg = "C:\Users\fratep\Desktop\Long-term EWM Study Data Files\"
strPath = BrowseFolder(strBrowseMsg)
If strPath = "" Then
   MsgBox "No folder was selected.", vbOK, "No Selection"
   Exit Sub
End If

   ' Replace tablename with the real name of the table into which
   ' the data are to be imported
strTable = "tablename"

strFile = Dir(strPath & "\*.xls")
  Do While Len(strFile) > 0
    strPathFile = strPath & "\" & strFile
    DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _
        strTable, strPathFile, blnHasFieldNames

 ' Uncomment out the next code step if you want to delete the
 ' EXCEL file after it's been imported
 '       Kill strPathFile

   strFile = Dir()
 Loop



Sub ImportMultiExcels()

End Sub

来自上面的第一个链接，但我似乎无法让他们做我正在寻找的事情。谁能帮帮我？

我是 VBA 新手，所以对编辑代码有点不确定。

Answer 1

您似乎可以使用导入向导将工作表成功导入 Access。在这种情况下，您应该能够使用 DoCmd.TransferSpreadsheet Method 在 Access 数据库中的 VBA 代码中执行相同的操作。

以下过程将名为 XYZ Priority 的单个工作表导入为名为 Import1 的 Access 表。

我使用一个常量作为工作表名称，因为您说目标工作表在所有源工作簿文件中具有相同的名称。

我将表名构造为 "Import" 加上 i。当您将此扩展到多个工作簿时，您可以在每次导入后增加 i。或者您可能对表名有不同的策略；你没说。

我将TransferSpreadsheet 语句拆分为几行，并包含选项名称以（希望）使其更易于理解。

我的工作表包含列名，所以我有HasFieldNames:=True

我的工作簿是使用旧版本的 Excel 创建的。 SpreadsheetType:=acSpreadsheetTypeExcel9 与此一起使用； SpreadsheetType 可能需要不同的值

Public Sub Demo_TransferSpreadsheet()
    Const cstrSheetName As String = "XYZ Priority"
    Dim i As Long
    Dim strFileName As String
    Dim strTableName As String

    ' my workbook is located in the same folder as the Access db file
    strFileName = CurrentProject.Path & Chr(92) & "temp.xls"
    i = 1
    strTableName = "Import" & CStr(i)

    DoCmd.TransferSpreadsheet _
        TransferType:=acImport, _
        SpreadsheetType:=acSpreadsheetTypeExcel9, _
        Tablename:=strTableName, _
        FileName:=strFileName, _
        HasFieldNames:=True, _
        range:=cstrSheetName & "$"
End Sub