自动导出访问表数据以填充模板 Excel 工作表

Posted 2023-03-27

【中文标题】自动导出访问表数据以填充模板 Excel 工作表

【英文标题】：Automated Export of Access Table-Data to Populate Template Excel Sheet

【发布时间】：2019-10-23 02:29:47

【问题描述】：

我正在将过滤后的表格数据从 Access 导出到 Excel 工作表，但我只能将表格数据导出到新的 Excel 文件中，而不是导出到模板 Excel 文件中（要填充预制的图表）。

我主要在 Access 上使用宏来创建一个总机，用户在该总机上按下一个总机按钮，过滤后的数据从 Access 中的表导出到 Reports 文件夹中的新 Excel 文件。我不知道宏是否能够与模板 Excel 文件一起导出，所以我转向学习 VBA。我是 VBA 的新手，所以我为我的微不足道的理解道歉。我根据 Youtube 上的 Access Jujitsu 的教程创建了一些 VBA 代码。

Private Sub Command0_Click()
On Error GoTo SubError

    Dim xlApp As Excel.Application
    Dim xlBook As Excel.Workbook
    Dim xlSheet As Excel.Worksheet
    Dim SQL As String
    Dim rs1 As DAO.Recordset
    Dim i As Integer
    Dim qtr As String

    'Show user work is being performed
    DoCmd.Hourglass (True)

    '*********************************************
    '              RETRIEVE DATA
    '*********************************************
    'SQL statement to retrieve data from database
    SQL = "SELECT Obj, Owner, Recom, Goal, Quality of Measure" & _
    "FROM Inventory " & _
    "WHERE Owner = ASM" &
    "ORDER BY Recom "

    'Execute query and populate recordset
    Set rs1 = CurrentDb.OpenRecordset(SQL, dbOpenSnapshot)

    'If no data, don't bother opening Excel, just quit
    If rs1.RecordCount = 0 Then
        MsgBox "No data selected for export", vbInformation + vbOKOnly, "No data exported"
        GoTo SubExit
    End If

    '*********************************************
    '             BUILD SPREADSHEET
    '*********************************************
    'Create an instance of Excel and start building a spreadsheet
    'Early Binding
    Set xlApp = Excel.Application

    xlApp.Visible = True
    Set xlBook = xlApp.Workbooks.Open("\Users\Desktop to TemplateACC.xlsx")
    Set xlSheet = xlBook.Worksheets(1)

    With xlSheet

        'Set second page title - pull quarter and year off of first row
        'Won't work if you are pulling multiple time periods!
        Select Case Nz(rs1!SalesQuarter, "")
            Case 1
                qtr = "1st"
            Case 2
                qtr = "2nd"
            Case 3
                qtr = "3rd"
            Case 4
                qtr = "4th"
            Case Else
                qtr = "???"
        End Select
        .Range("B3").Value = qtr & " Quarter " & Nz(rs1!SalesYear, "????")

        'provide initial value to row counter
        i = 1
        'Loop through recordset and copy data from recordset to sheet
        Do While Not rs1.EOF

            .Range("I" & i).Value = Nz(rs1!Owner, "")
            .Range("J" & i).Value = Nz(rs1!Goal, 0)
            .Range("K" & i).Value = Nz(rs1!Recom, 0)

            i = i + 1
            rs1.MoveNext

        Loop

    End With


SubExit:
On Error Resume Next

    DoCmd.Hourglass False
    xlApp.Visible = True
    rs1.Close
    Set rs1 = Nothing

    Exit Sub



SubError:
    MsgBox "Error Number: " & Err.Number & "= " & Err.Description, vbCritical + vbOKOnly, _
        "An error occurred"
    GoTo SubExit

End Sub

Private Sub Form_Load()

End Sub

我的代码在出错时不会运行，因为它说“未定义用户定义的类型”。我已经从新表单上的按钮构建了此代码，通过从按钮构建事件来打开 VBA 编码模板。我不确定为什么代码不会运行。它应该导出到一个名为“TemplateACC”的预先存在的文件，但出现了这个错误。感谢您在这方面坚持我！

【问题讨论】：

你需要在你的VB项目中添加对Excel应用对象模型的引用

【参考方案1】：

您是否添加了 Excel 对象库？

在 VBA 编辑器中转到工具 -> 参考，找到 Microsoft Excel 1X.0 对象库并检查它。

X 取决于安装的 Excel 版本，但应该只有一个，可能是 14 到 16。

【参考方案2】：

绑定可能是您的问题。您可以通过将 MS Excel 对象库添加到您的参考（工具 --> 参考）来实现早期绑定，或者您可以像下面这样实现后期绑定：

Private Sub Command0_Click()
Dim xlApp As object
Dim xlBook As object
Dim xlSheet As object

''If excel is already Running, grab that instance of the program, if not, create new
set xlApp = GetExcel
set xlBook = xlApp.Workbooks.Open("\Users\Desktop to TemplateACC.xlsx")
Set xlSheet = xlBook.Worksheets(1)

''... do other stuff

End sub

Function GetExcel() As Object 'Excel.Application

'Updated: 2009-10-13
'Used to grab the Excel application for automation

   If DetectExcel Then
       Set GetExcel = GetObject(, "Excel.Application")
   Else
       Set GetExcel = CreateObject("Excel.Application")
   End If

End Function

Function DetectExcel() As Boolean

' Procedure dectects a running Excel and registers it.
    Const WM_USER = 1024
    Dim hwnd As Long

''If Excel is running this API call returns its handle.
    hwnd = FindWindow("XLMAIN", 0)
    If hwnd = 0 Then ' 0 means Excel not running.
        DetectExcel = False
        Exit Function
    ''Excel is running so use the SendMessage API
    ''function to enter it in the Running Object Table.
        DetectExcel = True
        SendMessage hwnd, WM_USER + 18, 0, 0
    End If

End Function