Excel VBA代码在使用任务计划程序发送Outlook电子邮件时抛出运行时错误429

Question

我正在使用Excel VBA宏发送与Windows任务计划程序一起运行的自动电子邮件（Outlook 2013）（我正在使用批处理文件来执行此操作）在特定时间每天。当我运行没有任务计划程序的宏时，它会正常执行（发送电子邮件），但是当我使用Task Scheduler来收到“运行时错误429”时，只会在VBA宏试图创建Outlook对象时发生：

Dim OutApp As Object 
Dim OutMail As Object 

Set OutApp = CreateObject("Outlook.Application") 'The error happens here 
Set OutMail = OutApp.CreateItem(0) 

On Error Resume Next 
With OutMail 
    .to = "[email protected]" 
    .CC = "" 
    .BCC = "" 
    .Subject = "subj" 
    .Body = "body" 
    .Attachments.Add ActiveWorkbook.FullName 
    .Send 
End With 
On Error GoTo 0 

Set OutMail = Nothing 
Set OutApp = Nothing 

上述错误只发生在Outlook应用程序在计算机上打开的情况下。 现在我不明白的是：

1. 为什么宏观正常工作不用任务调度程序（尽管展望是开放与否），为什么不能在那儿工作吗？

2. 如何使整个过程执行使用任务计划程序，而不是依赖Outlook应用程序正在打开或关闭？ （即我希望宏运行，而不管哪些应用程序是打开/关闭的）。

建议将不胜感激。

编辑：这是VBScript代码我使用的执行宏（在repsonse到LS_ᴅᴇᴠ的问题）：

Dim WshShell 
Set WshShell = CreateObject("WScript.Shell") 

' Create an Excel instance 
Dim myExcelWorker 
Set myExcelWorker = CreateObject("Excel.Application") 

' Disable Excel UI elements 
myExcelWorker.DisplayAlerts = False 
myExcelWorker.AskToUpdateLinks = False 
myExcelWorker.AlertBeforeOverwriting = False 
myExcelWorker.FeatureInstall = msoFeatureInstallNone 

' Tell Excel what the current working directory is 
' (otherwise it can't find the files) 
Dim strSaveDefaultPath 
Dim strPath 
strSaveDefaultPath = myExcelWorker.DefaultFilePath 
strPath = WshShell.CurrentDirectory 
myExcelWorker.DefaultFilePath = strPath 

' Open the Workbook specified on the command-line 
Dim oWorkBook 
Dim strWorkerWB 
strWorkerWB = strPath & "\____DailyReport.xlsm" 

Set oWorkBook = myExcelWorker.Workbooks.Open(strWorkerWB) 

' Build the macro name with the full path to the workbook 
Dim strMacroName 
strMacroName = "'" & strPath & "\____DailyReport.xlsm'" & "!Module1.____DailyRep" 
on error resume next 
    ' Run the calculation macro 
    myExcelWorker.Run strMacroName 
    if err.number <> 0 Then 
     ' Error occurred - just close it down. 
    End If 
    err.clear 
on error goto 0 

'oWorkBook.Save 
'oWorkBook.Close <<--- we don't need these two because we close the WB in the VBA macro 

myExcelWorker.DefaultFilePath = strSaveDefaultPath 

' Clean up and shut down 
Set oWorkBook = Nothing 

' Don’t Quit() Excel if there are other Excel instances 
' running, Quit() will 
'shut those down also 
if myExcelWorker.Workbooks.Count = 0 Then 
    myExcelWorker.Quit 
End If 

Set myExcelWorker = Nothing 
Set WshShell = Nothing 

Answer 1

请按照下面的：

1）写一个Excel文件，该文件保存为SendEmail.xlsm，你的子：

Option Explicit 

Public Sub send_email() 



Dim OutApp As Object 
Dim OutMail As Object 

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

On Error Resume Next 
With OutMail 
    .to = "[email protected]" 
    .CC = "" 
    .BCC = "" 
    .Subject = "subj" 
    .Body = "body" 
    .Attachments.Add ActiveWorkbook.FullName 
    .Send 
End With 
On Error GoTo 0 

Set OutMail = Nothing 
Set OutApp = Nothing 

End Sub 

2）打开一个记事本编写代码，并保存为VBS（SendEmail.vbs）

Dim args, objExcel 

Set args = WScript.Arguments 
Set objExcel = CreateObject("Excel.Application") 

objExcel.Workbooks.Open args(0) 
objExcel.Visible = True 

objExcel.Run "send_email" 

objExcel.ActiveWorkbook.Save 
objExcel.ActiveWorkbook.Close(0) 
objExcel.Quit 

3）打开记事本编写这段代码并保存为bat（SendEmail.bat），我将它保存在我的桌面上，你可以将它保存到任何你想要的地方。

cscript "D:\desktop\SendEmail.vbs" "D:\desktop\SendEmail.xlsm" 

4）创建一个用于调用SendEmail.bat调度任务

Answer 2

你应该先检查是否Outlook正在运行，如果是，重视它，而不是创建一个新的会话：

On Error Resume Next 
Set objOutlook = GetObject(, "Outlook.Application") 'Error if Outlook not running 
On Error GoTo 0 
If objOutlook Is Nothing Then 'Outlook not running so start it 
    Set objOutlook = CreateObject("Outlook.Application") 
End If 

Answer 3

这是导致错误的原因是，我试图运行“使用最高权限”的任务：

这显然是不可行的我环境，所以当我取消选中它时，我使用的VBScript和由@Nikolaos Polygenis建议的VBScript都正常执行。