ms-access - 自动将不同的 Excel 文件导入 MS Access 2010 表

Question

我想将所有 Excel 文件(具有不同的数据和列)从某个目录导入到 MS Access 2010 数据库中，为每个文件创建新表。我找到了将文件导入到一个表中的代码:

Option Compare Database
Option Explicit

Function DoImport() 

Dim strPathFile As String, strFile As String, strPath As String
 Dim strTable As String
 Dim blnHasFieldNames As Boolean

 ' Change this next line to True if the first row in EXCEL worksheet
 ' has field names
 blnHasFieldNames = True

 ' Replace C:\Documents\ with the real path to the folder that
 ' contains the EXCEL files
 strPath = "C:\Documents and Settings\myName\My Documents\Access Test\"

 ' 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

End Function

但我每次都需要创建新表。在VBA中可以吗？

Answer 1

我认为您需要做的就是每次执行 DoCmd.TransferSpreadsheet 之前更改目标表名称(strTable 的值)。

在评论中您说您希望表名源自工作簿文件名。并且，每次循环时，另一个变量 (strFile) 包含文件名。因此，我认为您可以从该文件名中去除文件扩展名并将其用作 Access 表名称。

这是一个立即窗口示例，演示了如何做到这一点......

strFile = "foo.xls"
strTable = Left(strFile, Len(strFile) - 4)
? strTable
foo

如果该方法合适，请修改 VBA 代码中的循环，如以下(未经测试的)代码片段...

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