excel - 使用格式和布局将多个表从 Access DB 导出到 Excel 工作簿

Question

我正在尝试使用下面给出的 VBA 脚本导出多个表，它成功导出了具有多个工作表的工作簿中的所有表数据，但数据格式和布局不会像您通过选择单个表并检查以保留手动执行时那样保留数据格式和布局。

无论如何使用 vba 脚本来导出所有具有格式和布局的表格？

Sub expotT()
    Dim td As DAO.TableDef, db As DAO.Database
    Set db = CurrentDb()
    For Each td In db.TableDefs
        If Left(td.Name, 4) <> "msys" Then
            DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, _
                                      td.Name, "C:\xExcelTables.xls", True, td.Name
        End If 
    Next
End Sub

Answer 1

通过手动导出 Access 表意味着使用 GUI 功能区功能 External Data > Export > Excel , 那么对应的方法就是 DoCmd.OutputTo而不是 DoCmd.TransferSpreadsheet后者是速度更快的 Excel 导出器，没有任何格式。但是，前者不允许轻松添加工作表，而只能将每个表导出到整个工作簿。

因此，您需要连接到 Excel.Application COM 对象将所有导出的工作簿迁移到具有原始格式的单个最终工作簿。您可以使用 VBA 和 Excel 的 Worksheet.Copy 来做到这一点。方法。

Public Sub ExportAccTables()
    Dim td As DAO.TableDef, db As DAO.Database
    Dim xlApp As Object, targetWb As Object, sourceWb As Object
    Dim strFile As String

    Set xlApp = CreateObject("Excel.Application")
    Set targetWb = xlApp.Workbooks.Add()                  ' CREATE NEW WORKBOOK

    Set db = CurrentDb()

    For Each td In db.TableDefs
        If Left(td.name, 4) <> "msys" Then
            ' EXPORT INDIVIDUAL WORKBOOKS
            strFile = "C:\Path\To\Excel_" & td.name & ".xls"
            DoCmd.OutputTo acOutputTable, td.name, acFormatXLS, strFile

            ' COPY FORMATTED WORKSHEET TO TARGET WORKBOOK
            Set sourceWb = xlApp.Workbooks.Open(strFile)
            sourceWb.Worksheets(1).Copy After:=targetWb.sheets(targetWb.sheets.Count)
            sourceWb.Close False

            ' DELETE INDIVIDUAL WORKBOOK
            If Len(Dir(strFile)) <> 0 Then Kill strFile
        End If
    Next td

    targetWb.sheets(1).Delete                            ' DELETE DEFAULT FIRST SHEET
    targetWb.SaveAs "C:\Path\To\FinalWorkbook.xls", 56   ' SAVE TARGET WORKBOOK (.xls)
    targetWb.Close True                                  ' CLOSE WORKBOOK
    xlApp.Quit                                           ' QUIT BACKGROUND APP

    ' RELEASE RESOURCEES
    Set td = Nothing: Set db = Nothing
    Set sourceWb = Nothing: Set targetWb = Nothing: Set xlApp = Nothing
    Exit Sub
End Sub