我已经从数据库中提取数据并将其转换为自动生成并通过电子邮件发送的excel文件。我不知道是如何在关闭excel文件时使excel文件弹出一个消息框。我知道这样做是有可能的，因为我已经在常规的excel文件中做了很多次。
我认为问题在于访问文件中仅生成.xlsx文件，而不生成.xlsm文件。或我尝试使用的VBA代码不合适（无论是放置代码还是放置代码本身。
如果您能解决问题，并且想知道消息框应显示什么，我只想问“您是否已完成任务？”是/否盒子没什么疯狂的。
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
答案 0 :(得分：1)
编辑：下面列出的代码在18/7/16星期一进行了更新，以反映自上周这篇原始文章以来我所做的工作。新代码已在Office 2007中经过全面测试并可以正常使用，但是需要使用适当的文件名，表，查询，电子邮件地址等进行自定义。总的来说，很高兴我终于可以正常工作了，因为我一直想要用嵌入式代码以编程方式生成Access表单和报告。
我将在这里继续我的评论。换句话说，Access VBA模块需要将新代码写入Excel VBA模块。为了允许这样做，Access VBA项目将需要引用VBIDE或Microsoft Visual Basic for Applications Extensibility。该库允许相当广泛的访问，以自动化VBA IDE，也就是您在其中编写代码的窗口。
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
答案 1 :(得分：0)
在此处重新发布以确保@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
'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 = "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