在正确的范围内获取 DoCmd 或替代导出数十个 Access 数据库中的所有表

如何解决在正确的范围内获取 DoCmd 或替代导出数十个 Access 数据库中的所有表

我想做的很简单：

遍历目录中的所有 string_text 文件
打开它们并将所有表导出到单独的 .accdb 文件

我遇到的问题是 .xlsx 的范围，我很难更改它。问题出现了，因为我从基本上是空的 DoCmd 运行 VBA。当 VBA 到达 Database1.accdb 时，它使用的是 DoCmd.TransferSpreadsheet 而不是使用 CurrentDb 打开的 Access 文件。它是说一个明显可以看到（OpenDatabase 有效）的表不存在。

见下文：

Debug.Print(tbl.Name)

所以我的问题：

有没有一种方法可以设置 Option Compare Database Public Const PROJECT_PATH = "\\192.168.1.2\Migration\" Public Const DESC_PATH = PROJECT_PATH & "Descriptions\" Public Const DESC_DB_PATH = DESC_PATH & "DBs\" Public Const DESC_EXPORTS = DESC_PATH & "Exports\" Sub ExportDescriptionTables() Dim wrkSpace As Workspace,_ db As Database,_ tbl As TableDef ' ************************** TEMPLATE FILES - BEGIN ************************* Set dbDirObj = CreateObject("Scripting.FileSystemObject") Set dbFolder = dbDirObj.GetFolder(DESC_DB_PATH) Set dbFiles = dbFolder.Files ' ************************** TEMPLATE FILES - END *************************** ' Create the Access object for this file Set wrkSpace = CreateWorkspace("","admin","",dbUseJet) ' Iterate through each Access file For Each dbFile In dbFiles ' Open each Access database file Set db = wrkSpace.OpenDatabase(DESC_DB_PATH & dbFile.Name) ' Iterate through each table For Each tbl In db.TableDefs ' Export based on the table name matching specific criteria If Left(tbl.Name,1) <> "~" And Left(tbl.Name,4) <> "MSys" Then Debug.Print (tbl.Name) ' ################### THIS WHERE THE ERROR OCCURES ############## DoCmd.TransferSpreadsheet acExport,acSpreadsheetTypeExcel12,tbl.Name,DESC_EXPORTS & tbl.Name & dbFile.Name,True,tbl.Name End If Next tbl ' Close database db.Close ' Clear out access object for this file Set db = nothing Next dbFile End Sub 的范围？
如果没有，有什么更好的方法来解决这个问题（也许从 Excel 运行可能会迫使 DoCmd 成为唯一打开的 Access DB，这应该将 CurrentDb 带入适当的范围）？立>

解决方法

没有。始终将 DoCmd 视为用户可以通过用户界面执行的操作。
当找到要导出的数据库和其中的表时，链接这个/这些到主数据库（使用 DoCmd.TransferDatabase），然后导出每个链接的表并删除它之后。

DoCmd 是 Application 对象的子对象。您可以创建一个新的 Access 应用程序会话并在那里打开您的目标数据库。然后，当您在该会话中调用 DoCmd.TransferSpreadsheet 时，它将在其“自己的”数据库中查找您要求其导出的表（或查询）的名称。

这是一个简单的例子，它只从一个数据库中导出一个表。

Dim objAccess As Object

Set objAccess = CreateObject("Access.Application")
'objAccess.Visible = True ' useful during development and for trouble-shooting

objAccess.OpenCurrentDatabase "C:\Temp\Northwind_2007.accdb"
objAccess.DoCmd.TransferSpreadsheet acExport,acSpreadsheetTypeExcel12Xml,_
    "Customers","C:\Temp\Customers.xlsx"

objAccess.CloseCurrentDatabase
objAccess.Quit