使用 MessageBox 访问文件创建 Excel
Access File creating Excel With MessageBox
我已经让我的访问文件从数据库中提取数据并将其转换为自动生成并通过电子邮件发送的 excel 文件。我想不通的是如何使 excel 文件在关闭 excel 文件时弹出一个消息框。我知道这是可以做到的，因为我已经在常规 excel 文件上做过很多次了。
我认为问题出在仅生成 .xlsx 文件而非 .xlsm 文件的访问文件中。或者我尝试使用的 VBA 代码不正确（无论是代码的放置还是代码本身。
如果你能解决它并且想知道消息框应该说什么，我只是想要一个 "Have you complete the task?" Yes/No 框没有什么疯狂的。
FilePath = "\ms000ew01\Departments\Reporting\Reports"
FileName = FilePath & "\" & GrName & ShipDate & Timestamp
Attachfile = FileName & ".xlsm"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Draft",
FileName, True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Turn",
FileName, True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Final",
FileName, True
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = False
.Workbooks.Open (FileName & ".xlsm")
.Sheets("Draft").Select
.ActiveSheet.UsedRange.Font.Name = "Tahoma"
.ActiveSheet.UsedRange.Font.Size = 8
xlApp.Cells.EntireColumn.AutoFit
xlApp.Cells.EntireRow.AutoFit
.Sheets("Turn").Select
.ActiveSheet.UsedRange.Font.Name = "Tahoma"
.ActiveSheet.UsedRange.Font.Size = 8
xlApp.Cells.EntireColumn.AutoFit
xlApp.Cells.EntireRow.AutoFit
.Sheets("Final").Select
.ActiveSheet.UsedRange.Font.Name = "Tahoma"
.ActiveSheet.UsedRange.Font.Size = 8
xlApp.Cells.EntireColumn.AutoFit
xlApp.Cells.EntireRow.AutoFit
Set xlApp = Nothing
Dim OutApp As Object
Dim MailObj As Object
Set OutApp = CreateObject("Outlook.Application")
Set MailObj = OutApp.CreateItem(olMailItem)
With MailObj
.To = EmailTo
.Subject = GrName & " Report"
.Body = "Attached is your report"
.Attachments.Add Attachfile
.Send
End With
Set OutApp = Nothing
Set MailObj = Nothing
rst.MoveNext
End With
End Sub
编辑：下面列出的代码已于 2018 年 7 月 16 日星期一更新，以反映自上周 post 原始版本以来我所做的工作。新代码已经过全面测试并在 Office 2007 中正常运行，但是需要使用正确的文件名、表格、查询、电子邮件地址等对其进行自定义。总而言之，很高兴我终于可以正常工作了，因为我一直想要以编程方式生成带有嵌入式代码的 Access 表单和报告。
我会在这里继续我的评论。换句话说，Access VBA 模块需要将新代码写入 Excel VBA 模块。为了实现这一点，Access VBA 项目需要引用 VBIDE 又名 Microsoft Visual Basic for Applications Extensibility。该库允许相当广泛地访问 VBA IDE 也就是您在其中编写代码的 windows 的自动化。
Chip Pearson（在 4 月的一场车祸后于 6 月不幸去世）收集了关于 VBIDE：cpearson.com/excel/vbe.aspx 编码的优秀网页。不幸的是，我现在在任何 Microsoft Pages 上都找不到 VBIDE 有用的命令参考；他们似乎已经删除了除 Office 365 之外的所有内容，剩下的并不多。这遵循了 Microsoft 长期以来对 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
在此处重新发布以确保@louvac 看到它。我将代码发布为对我之前答案的编辑，但没有收到他的回音。
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
'embedded double-quotes in the strings, this can get 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.
'Otherwise, rebooting is the only way to get rid of them.
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 = "user@email.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
我已经让我的访问文件从数据库中提取数据并将其转换为自动生成并通过电子邮件发送的 excel 文件。我想不通的是如何使 excel 文件在关闭 excel 文件时弹出一个消息框。我知道这是可以做到的，因为我已经在常规 excel 文件上做过很多次了。
我认为问题出在仅生成 .xlsx 文件而非 .xlsm 文件的访问文件中。或者我尝试使用的 VBA 代码不正确（无论是代码的放置还是代码本身。
如果你能解决它并且想知道消息框应该说什么，我只是想要一个 "Have you complete the task?" Yes/No 框没有什么疯狂的。
FilePath = "\ms000ew01\Departments\Reporting\Reports"
FileName = FilePath & "\" & GrName & ShipDate & Timestamp
Attachfile = FileName & ".xlsm"
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Draft",
FileName, True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Turn",
FileName, True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12, "Final",
FileName, True
Dim xlApp As Object
Set xlApp = CreateObject("Excel.Application")
With xlApp
.Visible = False
.Workbooks.Open (FileName & ".xlsm")
.Sheets("Draft").Select
.ActiveSheet.UsedRange.Font.Name = "Tahoma"
.ActiveSheet.UsedRange.Font.Size = 8
xlApp.Cells.EntireColumn.AutoFit
xlApp.Cells.EntireRow.AutoFit
.Sheets("Turn").Select
.ActiveSheet.UsedRange.Font.Name = "Tahoma"
.ActiveSheet.UsedRange.Font.Size = 8
xlApp.Cells.EntireColumn.AutoFit
xlApp.Cells.EntireRow.AutoFit
.Sheets("Final").Select
.ActiveSheet.UsedRange.Font.Name = "Tahoma"
.ActiveSheet.UsedRange.Font.Size = 8
xlApp.Cells.EntireColumn.AutoFit
xlApp.Cells.EntireRow.AutoFit
Set xlApp = Nothing
Dim OutApp As Object
Dim MailObj As Object
Set OutApp = CreateObject("Outlook.Application")
Set MailObj = OutApp.CreateItem(olMailItem)
With MailObj
.To = EmailTo
.Subject = GrName & " Report"
.Body = "Attached is your report"
.Attachments.Add Attachfile
.Send
End With
Set OutApp = Nothing
Set MailObj = Nothing
rst.MoveNext
End With
End Sub
编辑：下面列出的代码已于 2018 年 7 月 16 日星期一更新，以反映自上周 post 原始版本以来我所做的工作。新代码已经过全面测试并在 Office 2007 中正常运行，但是需要使用正确的文件名、表格、查询、电子邮件地址等对其进行自定义。总而言之，很高兴我终于可以正常工作了，因为我一直想要以编程方式生成带有嵌入式代码的 Access 表单和报告。
我会在这里继续我的评论。换句话说，Access VBA 模块需要将新代码写入 Excel VBA 模块。为了实现这一点，Access VBA 项目需要引用 VBIDE 又名 Microsoft Visual Basic for Applications Extensibility。该库允许相当广泛地访问 VBA IDE 也就是您在其中编写代码的 windows 的自动化。
Chip Pearson（在 4 月的一场车祸后于 6 月不幸去世）收集了关于 VBIDE：cpearson.com/excel/vbe.aspx 编码的优秀网页。不幸的是，我现在在任何 Microsoft Pages 上都找不到 VBIDE 有用的命令参考；他们似乎已经删除了除 Office 365 之外的所有内容，剩下的并不多。这遵循了 Microsoft 长期以来对 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
在此处重新发布以确保@louvac 看到它。我将代码发布为对我之前答案的编辑，但没有收到他的回音。
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
'embedded double-quotes in the strings, this can get 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.
'Otherwise, rebooting is the only way to get rid of them.
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 = "user@email.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