任务计划程序不运行Excel VBA代码将PDF作为电子邮件附件发送

问题描述:

以下是我正在使用的软件/系统:
Microsoft Office 2010;
任务计划程序;
的Windows Server 2008 R2标准
任务计划程序不运行Excel VBA代码将PDF作为电子邮件附件发送

我正在运行执行以下操作一个Excel文件中的一些VBA代码:


1.通过SQL/ODBC连接
2.上传从我们的数据库中检索数据数据添加到工作簿中的原始数据表中,并使用now功能将工作簿标记在单元格中
3.刷新并格式化工作簿中的每个数据透视表
4.将指定的图表导出并保存为PDF文档并保存文件na我用步骤2中的时间戳
5.保存工作簿
6.将在Excel中创建为特定PDF文档的电子邮件附件创建为电子邮件附件。
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的Modules部分通过电子邮件发送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 protected]" 
     .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

任何人都知道什么是造成宏观上完美运行,当我亲自打开该文件,然后当我尝试并通过任务计划程序打开文件它停在同一个地方? 有人知道如何使它通过任务计划程序正确运行?

谢谢!

+0

试着评论'On Error Resume Next'。也许你会知道发生了什么错误。 – xidgel

我们意识到服务器限制了我在任务调度程序中的权限。当我让IT Director将我的权限交给Admin后,它完美地运行了任务调度程序!

对不起虚惊一场......我原本不会发布这个问题,但我上周花了所有的时间在这方面进行研究。感谢大家的期待!

这是我的猜测。你必须确保你的密码输入正确。如果您长按某个键并输入错误密码,则任务计划程序将会接受它,即使它不应该。在我的观点中,它应该提示用户并通知他/她这个错误。也许微软会在不久的将来改变这一点。