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

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

问题描述:

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

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 
+0

作为一个Excel宏,您将什么批次放入任务调度程序? –

+0

@LS_ᴅᴇᴠ我使用这里描述的VBScript:[Excel:在Windows Task Scheduler上运行Excel](http://krgreenlee.blogspot.com/2006/04/excel-running-excel-on-windows-task.html)和我的批处理文件看起来像这样:'开始“”“”D:\ Documents \ Macros \ ___ \ Run__Rep.vbs“' –

+0

所以,另一个问题...... VBS包含什么? –

请按照下面的:

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调度任务

+0

非常感谢!你的方法解决了!我正在使用这里描述的方法:Excel:[在Windows任务计划程序上运行Excel](http://krgreenlee.blogspot.com/2006/04/excel-running-excel-on-windows-task.html),但它wouldn正如我上面提到的那样工作。我只剩下一个问题:在网站上描述的脚本中,如果有其他实例正在运行,可以放弃Excel,但是使用脚本,它仍然不会退出Excel的其他实例,因此我应该保留原样,还是使用该检查方法? –

+0

是否要退出所有实例或只有脚本实例? –

+0

只有脚本实例,这意味着我希望其他实例保持运行(如果有其他实例)。 –

你应该先检查是否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 
+0

谢谢你的回答。我试图修改它的方式,但不幸的是,我试图从Task Scheduler运行它时遇到了同样的错误(否则它再次正常工作)。事情是这样的,当从Task Scheduler中运行代码时省略了'GetObject'这一行,并在'CreateObject'一行处抛出一个错误。 –

+1

您需要检查TS的权限。显然他们是不够的... – peakpeak

+0

你是完全正确的。我以“最高权限”运行任务,当我取消选中脚本正常执行时。 –

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

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