2

这是我正在使用的软件/系统:
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

任何人都知道是什么导致宏在我亲自打开文件时完美运行,然后当我尝试通过任务计划程序打开文件时它停在同一个位置? 有谁知道如何通过任务计划程序使其正确运行?

谢谢!

4

2 回答 2

1

我们意识到服务器限制了我在任务计划程序中的权限。当我去我的 IT 主管将我的权限切换到管理员时,它完美地运行了任务计划程序!

很抱歉误报......我最初不会发布这个问题,但我上周花了整整一周的时间来解决这个问题。谢谢大家观看!

于 2016-06-01T00:18:59.203 回答
0

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

于 2016-06-08T21:36:53.357 回答