这是我正在使用的软件/系统:
Microsoft Office 2010;
任务调度器;
Windows Server 2008 R2 标准版
我正在执行以下操作的 Excel 文件中运行一些 VBA 代码:
1. 通过 SQL/ODBC 连接从我们的数据库中检索数据
2. 将数据上传到工作簿中的原始数据表,并使用 now 函数在单元格中为工作簿添加时间戳
3. 刷新并格式化工作簿中的每个数据透视表
4. 导出并将指定的工作表另存为 PDF 文档,并使用步骤 2 中的时间戳保存文档名称
5. 保存工作簿
6. 通过电子邮件将刚刚创建的特定 PDF 文档作为 Excel 中的电子邮件附件发送。
7. 关闭 Excel 应用程序
我在一个名为 Workbook_Open 的私有子中运行这整个系列,它检查当前时间是否与指定的运行时匹配。如果是,它会运行步骤 1-7,如果是一个小时后,它会关闭工作簿(这样我就可以在两个小时的窗口之外处理它)。
这是正在使用的代码: *注意,下面的代码在“ThisWorkbook”Excel 对象中运行。
'This Macro will use check to see if you opened the workbook at a certain time, if you did, then it will run the Report Automation Macros below.
Private Sub Workbook_Open()
HourRightNow = Hour(Now())
If HourRightNow = 13 Then
Call RefreshDataTables
Call RefreshPivotTables
Call SaveWorkbook
Call ExportToPDFFile
Call EmailPDFAsAttachment
Call CloseWorkbook
ElseIf HourRightNow = 14 Then
Call CloseWorkbook
End If
End Sub
Sub RefreshDataTables()
'
' RefreshDataTables Macro
' This Macro is used to refresh the data from the Dentrix Tables.
'
'This selects the table and refreshes it.
Sheets("raw").Select
Range("D4").Select
Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
Worksheets("NomenclatureVBA").Range("A2").Formula = "=now()"
End Sub
Sub RefreshPivotTables()
'
' RefreshPivotTables Macro
' This Macro refreshes each Pivot Table in the document.
'
'This goes through each sheet and refreshes each pivot table.
Sheets("D0150 VS D0330 BY BIZLINE").PivotTables("D0150 vs D0330 by BIZLINE").PivotCache.Refresh
Columns("B:DD").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Sheets("D0150 VS D0330").PivotTables("D0150 COMP EXAM vs D0330 PANO").PivotCache.Refresh
Columns("B:DD").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
'Formnats to the specific date format below.
End Sub
'--------------------------------------------------------------------------------------------------------------
Sub SaveWorkbook()
' Saves Active (Open) Workbook
ActiveWorkbook.Save
End Sub
'**********************READY************************
'More simplified and tested version of the Export To PDF format
'Make sure to update the filePaths, worksheets,
Sub ExportToPDFFile()
Dim strFilename As String
'Considering Sheet1 to be where you need to pick file name
strFilename = Worksheets("NomenclatureVBA").Range("C2")
Sheets(Array("D0150 VS D0330", "D0150 VS D0330 BY BIZLINE")).Select
Sheets("D0150 VS D0330").Activate
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
"\\****(ServerNameGoesHere)****\UserFolders\_Common\DentrixEntrpriseCustomReports\Public\Owner Reports\DataAnalystAutomatedReports\Reports\D0150 COMP EXAM vs D0330 PANO\" & strFilename & ".pdf" _
, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas _
:=False, OpenAfterPublish:=False
Sheets("NomenclatureVBA").Select
'This is where the exporting ends, now we will proceed to email the file.
'-----------------------------------------------------------------------------
'The emailing begins here
'This says that if there is a file name stored in the strFileName variable, then....
End Sub
'This Macro Closes the workbook... Note that it closes the very specific workbook you choose.
Sub CloseWorkbook()
'Workbooks("Automated D0150 COMP EXAM vs D0330 PANO.xlsm").Close SaveChanges:=False
Application.DisplayAlerts = False
Application.Quit
End Sub
然后我还有一个宏,可以在 VBA 的模块部分通过电子邮件发送 PDF 文件。它看起来像这样:
Sub EmailPDFAsAttachment()
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .
Dim OutApp As Object
Dim OutMail As Object
Dim FilePath As String
'This part is setting the strings and objects to be things. (e.g. FilePath is setting itself equal to the text where we plan to set up each report)
FilePath = "\\***(ServerGoesHere)***\UserFolders\_Common\DentrixEntrpriseCustomReports\Public\Owner Reports\DataAnalystAutomatedReports\Reports\D0150 COMP EXAM vs D0330 PANO\" _
& Worksheets("NomenclatureVBA").Range("C2") & ".pdf"
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
' Change the mail address and subject in the macro before you run it.
'
With OutMail
.To = "email@example.com"
.CC = ""
.BCC = ""
.Subject = Worksheets("NomenclatureVBA").Range("C2")
.HTMLBody = "Hello all!" & "<br>" & _
"Here is this week's report for the Comp Exam vs. Pano." & "<br>" & _
"Let me know what you think or any comments or questions you have!" & "<br>" & _
vbNewLine & Signature & .HTMLBody
.Attachments.Add FilePath
' In place of the following statement, you can use ".Display" to
' display the mail.
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
因此,当我在第 13 小时(下午 1 点)打开工作簿时,这一切都运行良好,但是,当我在第 13 小时尝试在任务计划程序中运行它时,它会运行所有内容,直到 EmailPDFAsAttachment 宏/子它被挂断宏中的某处并停止运行。
我还应该声明我在 Outlook 和 Excel 中都有以下信任中心设置: TrustCenterSettings
任何人都知道是什么导致宏在我亲自打开文件时完美运行,然后当我尝试通过任务计划程序打开文件时它停在同一个位置? 有谁知道如何通过任务计划程序使其正确运行?
谢谢!