VBS脚本手动运行，但不通过调度程序运行

I have created a VBA script that sends an email of a graph when evoked. I am trying to set up a scheduled job to send out the email every day at 9:30 am.

我创建了一个VBA脚本，在发生时发送图表的电子邮件。我正在尝试设置一个预定的工作，以便每天上午9:30发送电子邮件。

I have created a VBS script that runs fine when I call it (i.e., cscript.exe EmailDailyBurnDown.VBS), but the script will not work when evoked via scheduler. Can you help?

我创建了一个VBS脚本，当我调用它时运行正常（即cscript.exe EmailDailyBurnDown.VBS），但是当通过调度程序唤起时脚本将不起作用。你能帮我吗？

EmailDailyBurnDown.VBS

EmailDailyBurnDown.VBS

Dim ObjExcel, ObjWB
Set ObjExcel = CreateObject("Excel.Application")
Set ObjWB = ObjExcel.Workbooks.Open("C:\20170814_Promotion Work Backlog_V1.0.9.xlsm")
ObjExcel.Visible = False
ObjExcel.DisplayAlerts = False
ObjExcel.AskToUpdateLinks = False
ObjExcel.AlertBeforeOverwriting = False

'vbs opens a file specified by the path below
'either use the Workbook Open event (if macros are enabled), or Application.Run

ObjExcel.Application.Run "SendBurnDownChartViaEmail"
ObjWB.Save
ObjWB.Close
ObjExcel.Quit

Set ObjWB = Nothing
Set ObjExcel = Nothing
WScript.Echo "Finished."
WScript.Quit

VBA Script

VBA脚本

Sub SendBurnDownChartViaEmail()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim Fname As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    'File path/name of the gif file
    Fname = Environ$("temp") & "\My_Sales1.gif"

    'Save Chart named "Chart 1" as gif file
    ActiveWorkbook.Worksheets("Hidden").ChartObjects("Chart 1").Chart.Export _
            Filename:=Fname, FilterName:="GIF"
    'MsgBox (Fname)

    On Error Resume Next
    With OutMail
        .To = "akshay@xxxx.com"
        .CC = ""
        .BCC = ""
        .Subject = "FBT Sprint " & Worksheets("5. Capacity & Sprint Planning").Range("E11").Value & " Burn Down - " & Date
        .Attachments.Add Fname
        .HTMLBody = "<html>" & "<img src='cid:My_Sales1.gif'></html>"
        .Send   'or use .Display
        '.Display
    End With
    On Error GoTo 0

    'Delete the gif file
    Kill Fname

    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

I get the following error. Thanks for your help!

我收到以下错误。谢谢你的帮助！

Akshay

阿克沙伊

1 个解决方案

#1

Some googling brought up this result: https://www.devhut.net/2014/10/31/createobjectoutlook-application-does-not-work-now-what/

一些谷歌搜索带来了这个结果：https：//www.devhut.net/2014/10/31/createobjectoutlook-application-does-not-work-now-what/

The author does not state why it is the case that outlook automation won't work as seamlessly as it does with other MS Office software, but he provides an alternative way of binding an Outlook-instance, maybe this will solve your issue.

作者没有说明为什么Outlook自动化不能像其他MS Office软件那样无缝地工作，但他提供了另一种绑定Outlook实例的方法，这可能会解决您的问题。

(Only a link, no code since the author explicitly says not to repost his code)

（只有一个链接，没有代码，因为作者明确表示不会重新发布他的代码）

#1