编辑：下面列出的代码已于 2018 年 7 月 16 日星期一更新，以反映自上周发布原始帖子以来我所做的工作。新代码在 Office 2007 中经过了全面测试和功能，但是需要使用正确的文件名、表格、查询、电子邮件地址等进行自定义。总而言之，很高兴我终于得到了这个工作，因为我一直想要以编程方式生成带有嵌入代码的 Access 表单和报告。
我将在这里继续我的评论。换句话说，Access VBA 模块需要将新代码写入 Excel VBA 模块。为了实现这一点，Access VBA 项目需要引用VBIDE aka Microsoft Visual Basic for Applications Extensibility。该库允许对 VBA IDE 的自动化进行相当广泛的访问，也就是您编写代码的窗口。
Chip Pearson（他在 4 月的一场车祸后不幸于 6 月去世）收集了很多关于 VBIDE 编码的页面：cpearson.com/excel/vbe.aspx。不幸的是，我现在在任何 Microsoft 页面上都找不到有用的 VBIDE 命令参考；他们似乎已经删除了除 Office 365 之外的所有内容，剩下的并不多。这遵循了微软长期以来对 VBIDE 文档不足的传统。
我目前正在为我自己的项目解决这个问题，但有一点不同。需要编写的代码是按钮的Click 事件。并且要使用 VBIDE（而不是常规子程序或函数）编写事件，必须使用特殊方法：CreateEventProc。正如我所提到的，我的项目还没有完成，但我已经为你一起破解了这个代码示例。请注意，这是未测试的。我会看看我是否可以在今天晚些时候让它真正起作用。我们似乎都有相同的目标，即使用 Access VBA 创建 Excel 工作簿，然后将 VBA 写入其中，所以我有动力让它工作......
Public Function CreateExcelWorkbookWithEvents()
'This procedure is meant to reside in a Microsoft Access code module.
'This procedure requires two project references:
' 1) Microsoft Excel XX.Y Object Library (mine is 12.0)
' 2) Microsoft Outlook XX.Y Object Library (mine is 12.0)
' 3) Microsoft Visual Basic for Applications Extensibility X.Y (mine is 5.3)
'Project references are always preferred over CreateObject() when possible, since a
'reference allows the IntelliSense auto-complete to do its job. Otherwise, it's
'coding blind, and that's just no fun.
'Access variables.
Dim acc As Access.Application
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim rsRows As Long
Dim sqlText As String
'Excel variables.
Dim xl As Excel.Application
Dim wb As Excel.Workbook
Dim wss As Excel.Sheets
Dim ws As Excel.Worksheet
Dim ws1 As Excel.Worksheet
Dim ws2 As Excel.Worksheet
Dim ws3 As Excel.Worksheet
Dim firstCell As String
'VBIDE variables.
Dim proj As VBIDE.VBProject
Dim comp As VBIDE.VBComponent
Dim cmod As VBIDE.CodeModule
Dim code As String
'Outlook variables.
Dim olapp As Outlook.Application
Dim olmsg As Outlook.MailItem
'Other variables.
Dim filepath As String
Dim filename As String
Dim fileext As String
Dim fullFilename As String
Dim timestamp As String
'Filename construction.
filepath = "c:\windows\temp"
filename = "MyWb"
fileext = "xlsm"
timestamp = VBA.Format(Now(), "yyyymmddhhnnss")
fullFilename = filepath & "\" & filename & "_" & timestamp & "." & fileext
'Access objects.
Set acc = Access.Application
Set db = acc.CurrentDb
'Excel objects.
Set xl = New Excel.Application
'Create a new blank WB with one worksheet. The 'xlWBATWorksheet' parameter creates a
'new blank workbook with only one sheet instead of the usual three. A weird side
'effect of this is the workbook will have the name "Sheet1" instead of "Book1", but
'otherwise it's a perfectly normal workbook.
Set wb = xl.Workbooks.Add(xlWBATWorksheet)
'Uncomment and change text if desired.
'xl.Caption = "Workbook Title"
'Add & name the tabs.
Set wss = wb.Worksheets
Set ws1 = wss(1)
ws1.name = "tmpDraft"
Set ws2 = wss.Add(, wss(wss.Count), , xlWorksheet)
ws2.name = "tmpTurn"
Set ws3 = wss.Add(, wss(wss.Count), , xlWorksheet)
ws3.name = "tmpFinal"
ws1.Select 'Go back to the first sheet.
'Loop through worksheets, use tab names for the queries, dump the data into the sheets,
'then format them as desired.
firstCell = "A1" 'Where to put data on each sheet.
For Each ws In wss
sqlText = "SELECT * FROM " & ws.name & ""
Set rs = db.OpenRecordset(sqlText, dbOpenSnapshot, dbFailOnError)
rsRows = ws.Range(firstCell).CopyFromRecordset(rs) 'This
Set rs = Nothing
ws.Cells.Font.name = "Tahoma"
ws.Cells.Font.size = 8
ws.Cells.EntireColumn.AutoFit
ws.Cells.EntireRow.AutoFit
Next
'Add the event code. Build the code in a way that's easy to read. Because there are
'of embedded double-quotes in the strings, this part can get quite messy and
'difficult to read. So that's why VBA.Replace() is used. It makes the "code of code"
'much more freindly to human eyes. The code that's built here is only what's
'between Sub...End Sub, which are created automatically by CreateEventProc().
'
'Just as in Microsoft Word, the paragraph character indicates where a
'hard-return should be, but something offbeat had to be used to show the double
'quotes, so the degree symbol ° is used, that being Chr$(176). Although any
'character(s) which the programmer desires may be used, these were chosen because
'they do not appear as valid characters in VBA.
'
'Note: The section of the code below with the If-Then to detect if Excel is visible
'are needed because the wb.Close statement further down in this subroutine cause the
'event we just created to be trigged as if the user is attempting to exit Excel. This
'seemed to be the simplest way to handle this, with other options such as setting
'a global variable somehow in Excel while the code is being created, but I didn't\
'experiment with that.
'
code = ""
code = code & "Private Sub Workbook_BeforeClose(Cancel As Boolean)¶"
code = code & "Dim xlapp As Excel.Application¶"
code = code & "Dim msgResponse As VbMsgBoxResult¶"
code = code & "Dim msgTitle As String¶"
code = code & "Dim msgText As String¶"
code = code & "Dim msgStyle As Long¶"
code = code & "¶"
code = code & "'Detect if Excel is hidden, presumably because it was created via automation¶"
code = code & "'from another program. If so, do not prompt the user to confirm exit.¶"
code = code & "Set xlapp = Excel.Application¶"
code = code & "If xlapp.Visible = True Then¶"
code = code & " msgTitle = °Confirm Exit°¶"
code = code & " msgText = °Are you sure you want to exit?°¶"
code = code & " msgStyle = vbApplicationModal + vbExclamation + vbYesNo¶"
code = code & " msgResponse = MsgBox(msgText, msgStyle, msgTitle)¶"
code = code & " If msgResponse = vbNo Then¶"
code = code & " Cancel = True 'This is what cancels the Close event.¶"
code = code & " End If¶"
code = code & "End If¶"
code = code & "End Sub¶"
code = VBA.Replace(code, "¶", vbCrLf) 'Replace the ¶ characters with hard returns.
code = VBA.Replace(code, "°", VBA.Chr(34)) 'Replace the ° characters with double quotes.
'Dig into the VBA Project, create the event, and add the code. NOTE: There is an
'issue with manipulating code from VBA. You can't step through those lines in debug
'mode if you are adding code to the SAME file you're working in. For instance, if you're
'in an XLSM file, adding code to its own ThisWorkbook module. Won't work. It causes a
'runtime error. I think Chip Pearson mentioned it on his VBIDE pages, but I can't find it.
Set proj = wb.VBProject 'Grab the VBA project.
Set comp = proj.VBComponents("ThisWorkbook") 'Grab the "ThisWorkbook" code module.
Set cmod = comp.CodeModule 'Grab the ThisWorkbook code window.
cmod.InsertLines cmod.CountOfLines + 1, code 'Insert the code.
'Originally CreateEventProc() was used, but it was found to pop open the VBA IDE
'window, despite any attempt to prevent it. However, the same goal can be accomplished
'with the regular InsertLines() function. It's all text in the IDE anyways, and how it
'gets there doesn't matter. One need only be certain everything is spelled correctly.
'This is the original attempt:
'xl.vbe.MainWindow.Visible = False 'Hide the VBA editor from the user.
'firstLine = cmod.CreateEventProc("BeforeClose", "Workbook") + 1 'Create the event.
'Save as a macro-enabled workbook. Don't forget: each installation of Excel may need
'the macros enabled in the security settings.
wb.SaveAs fullFilename, xlOpenXMLWorkbookMacroEnabled
'Not sure if this is desired.
'xl.Visible = True
'Clear the variables. If the 'xl' variable is not released, lost instances of Excel
'will start to pile up in memory. They can be seen in Task Manager, but to be properly
'identified, click View > Select Columns > Command Line > Ok. The instances of Excel
'started from VBA will have the command line switch '/automation -Embedding' like this:
'"C:\Program Files (x86)\Microsoft Office\Office12\EXCEL.EXE" /automation -Embedding
'And even so, these instances of Excel may not unload from memory until this subroutine
'is finished and exits. It's a fussy thing with a difficult pattern to follow. I find if
'while devloping the code, when stepping through debug with F8, if I stop the macro
'prematurely, the automation instances tend to stack up and need to be manually killed.
wb.Close True
xl.Quit
Set wb = Nothing
Set xl = Nothing
'Create the email and send it.
Set olapp = New Outlook.Application
Set olmsg = olapp.CreateItem(olMailItem)
olmsg.To = "mshea@certobrothers.com"
olmsg.Subject = "Report"
olmsg.Body = "Attached is your report"
olmsg.Attachments.Add fullFilename, olByValue
olmsg.Send
Set olapp = Nothing
Set olmsg = Nothing
End Function