以下是我使用的软件/系统:
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宏/ sub和它挂在宏中的某个地方并停止运行。
我还应该声明我在Outlook和Excel中都具有以下信任中心设置: TrustCenterSettings
任何人都知道当我亲自打开文件时导致宏运行完美,然后当我尝试通过任务计划程序打开文件时,它会在同一位置停止运行吗? 有谁知道如何通过任务计划程序正确运行?
谢谢!
答案 0 :(得分:1)
我们意识到服务器限制了我在任务调度程序中的权限。当我去我的IT Director将我的权限切换到Admin时,它完全运行了任务调度程序!
对不起的警报......我原本不会发布这个问题,但我上周花了所有工作。谢谢大家的期待!
答案 1 :(得分:0)
这是我的猜测。您必须确保正确输入密码。如果你指责密钥并错误地输入密码,任务计划程序即使不应该接受它也会接受它。在我的意见中,它应该提示用户并通知他/她错误。也许微软会在不久的将来某个时候改变它。