将多个Excel文件中的一个工作表导入多个Access表

时间:2013-11-04 17:44:45

标签: excel vba ms-access ms-access-2007 access-vba

我有大约200个Excel文件,我想将其导入单个Access数据库,并为每个文件都有一个表。每个Excel文件都有多个工作表,但我想要导入的工作表一直名为。

我找到了一些代码,请参阅:http://www.accessmvp.com/KDSnell/EXCEL_Import.htm#ImpBrsFldFileshttp://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的新手,所以对编辑代码有点不确定。

1 个答案:

答案 0 :(得分: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