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

Question

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

我主要在 Access 上使用宏来创建交换机，其中用户按下交换机按钮，筛选的数据从 Access 中的表导出到"报表"文件夹中的新 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("UsersDesktop 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"的预先存在的文件，但出现此错误。谢谢你坚持我！

Answer 1

您是否添加了 Excel 对象库？

在VBA编辑器中，转到"工具"-">引用"，找到Microsoft Excel 1X.0对象库并进行检查。

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

Answer 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("UsersDesktop 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