时间戳

首页 > 解决方案 > 为文件夹中的每个 Access 文件 (.mdb) 创建一个 Excel 文件，表格为表格

vba - 为文件夹中的每个 Access 文件 (.mdb) 创建一个 Excel 文件，表格为表格

问题描述

任务

外部程序不断生成小型 .mdb 数据库文件。必须将数据库表中的数据加载到 STATA 中进行数据处理。

到目前为止我创建的工作流程是这样的：

我可以一次对单个文件执行此操作，但我想在一次运行中在最多包含 100 个 .mbd 文件的文件夹中执行此操作。

（这个问题特别是关于第 1 步，但我已将其余部分添加为上下文。如果您有更好或更直接的途径来完成主要任务，请在评论中告诉我）。

单个文件的步骤 1 的工作代码：

以下是我用来为单个文件创建 .xls 的 VBA 宏（来自此答案的代码的修改版本：https ://stackoverflow.com/a/13248627/1685346 ）：

Sub exportTables2XLS()
    Dim table As DAO.TableDef, database As DAO.Database
    Dim filePath As String, file As String, outFile As String

    filePath = CurrentProject.Path
    file = CurrentProject.Name

    Set database = CurrentDb()

    'Export all tables to outFile
    outFile = filePath & "\" & Left(file, Len(file) - 4) & ".xls"
    For Each table In database.TableDefs
        If Left(table.Name, 4) = "MSys" Then
            'Do nothing -- Skip system tables
        Else
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
            table.Name, outFile, True, Replace(table.Name, "dbo_", "")
        End If
    Next
End Sub

步骤 1 的几乎工作代码作为批处理操作

遍历文件夹Dir给出以下内容：

Sub batchExportTables2XLS()
    Dim table As DAO.tabledef, database As DAO.database
    Dim file As String, filePath As String, outFile As String
    Dim wrkAcc As Object

    filePath = CurrentProject.Path
    file = Dir(filePath & "/*.mdb")

    Do Until file = ""
        Set wrkAcc = CreateWorkspace("", "admin", "", dbUseJet)
        Set database = wrkAcc.OpenDatabase(file)

        'Export all tables to outFile
        outFile = filePath & "\" & Left(file, Len(file) - 4) & ".xls"
        For Each table In database.TableDefs
            If Left(table.Name, 4) = "MSys" Then
                'Do nothing -- Skip system tables
            Else
                DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                table.Name, outFile, True, Replace(table.Name, "dbo_", "")
            End If
        Next

        file = Dir()
    Loop
End Sub

此宏为文件夹中的每个 .mdb 生成一个 .xls 文件，但它们都包含与运行宏的 .mdb 中的表相对应的工作表。我觉得这很接近，但是我怎样才能让代码产生正确的输出呢？

标签： vbams-access

解决方案

这个问题是因为DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, table.Name, outFile, True, Replace(table.Name, "dbo_", "")发生在当前的应用程序实例中（也就是宏正在运行的地方，在这种情况下是您打开的访问应用程序）。要改变它，我们需要给它正确的应用程序来触发这个命令。

我对你的代码做了一些调整，让你知道该怎么做。不确定您是否需要 Workspace 功能，或者这正是您在 Web 上找到的功能，而是打开一个新的 Access 实例，一次加载一个数据库，并在 Access 应用程序的该实例中导出工作表。

Sub batchExportTables2XLS()
    Dim table As DAO.TableDef, database As DAO.database
    Dim file As String, filePath As String, outFile As String
    Dim appAccess As New Access.Application


    filePath = CurrentProject.Path
    file = Dir(filePath & "\*.mdb")



    Do Until file = ""
        appAccess.OpenCurrentDatabase filePath & "\" & file


        'Export all tables to outFile
        outFile = filePath & "\" & Left(file, Len(file) - 4) & ".xls"
        For Each table In appAccess.CurrentDb.TableDefs
            If Left(table.Name, 4) = "MSys" Then
                'Do nothing -- Skip system tables
            Else
                appAccess.DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, table.Name, outFile, True, Replace(table.Name, "dbo_", "")

            End If
        Next
        appAccess.CloseCurrentDatabase

        file = Dir()
    Loop
    Set appAccess = Nothing
End Sub

推荐阅读