Создайте файл Excel для каждого файла Access (.mdb) в папке с таблицами в виде листов - PullRequest
Новая
       9

Создайте файл Excel для каждого файла Access (.mdb) в папке с таблицами в виде листов

0 голосов
/ 10 мая 2019

Задача

Внешняя программа постоянно создает небольшие файлы базы данных .mdb.Данные из таблиц базы данных должны быть загружены в STATA для обработки данных.

Рабочий процесс, который я создал до сих пор, таков:

  • Шаг 1. Использование макроса VBA (вДоступ) для извлечения таблиц в листы в книге Excel
  • Шаг 2. Использование другого макроса VBA (в Excel) для очистки переменных для импорта STATA
  • Шаг 3. Использование плагина xls2dta (в STATA), чтобы объединить листы в один файл .dta

Я могу сделать это для одного файла за раз, но я хотел бы сделать это в папке до 100 .mbd-файлов за один прогон.

(Этот вопрос касается, в частности, шага 1, но я добавил остальное в качестве контекста. Если у вас есть лучший или более прямой маршрут для выполнения основной задачи, пожалуйста,меня знают в комментарии).

Рабочий код для шага 1 для одного файла:

Ниже приведен макрос VBA, который я использую для создания .xls для одного файла (aмодифицированная версия кода из этого ответа: 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

Этот макрос создает файл .xls для каждого .mdb впапку, но все они содержат листы, соответствующие таблицам в .mdb, из которого выполняется макрос.Я чувствую, что это очень близко, но как я могу получить код для получения правильного вывода?

1 Ответ

1 голос
/ 10 мая 2019

Это связано с тем, что DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, table.Name, outFile, True, Replace(table.Name, "dbo_", "") занимает место в текущем экземпляре приложения (то есть, где выполняется макрос, в данном случае приложение доступа, которое вы открыли).Чтобы изменить это, нам нужно дать ему правильное приложение для запуска этой команды.

Я внес некоторые изменения в ваш код, чтобы дать вам представление о том, что делать.Не уверен, что вам требуется функциональность Workspace или это было именно то, что вы нашли в Интернете, вместо этого он открывает новый экземпляр Access, загружает базы данных по одной за раз и экспортирует листы в экземпляр THAT приложения 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
...