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

我正在使用Excel VBAmacros来发送自动电子邮件（Outlook 2013），它在每天的特定时间与Windows任务计划程序（我正在使用batch file来执行此操作）一起运行。 当我运行我的macros没有任务计划程序它通常执行（电子邮件发送），但是当我使用任务计划程序，因为我收到“运行时错误429”，只有当VBAmacros尝试创buildOutlook对象时发生：

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 = "[e-mail]" .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. 为什么macros无法正常工作（不pipeOutlook是否打开），为什么它不工作呢？

2. 如何使整个过程执行使用任务计划，而不是依靠Outlook应用程序正在打开或closures？ （即我希望macros运行，无论哪些应用程序是打开/closures）。

build议将不胜感激。

编辑：这里是我用来执行macros（在repsonseLS_ᴅᴇᴠ的问题）的VBScript代码：

  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）写入一个保存为SendEmail.xlsm的Excel文件，你的Sub：

 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 = "[e-mail]" .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）打开一个记事本写这段代码并保存为蝙蝠（SendEmail.bat），我把它保存在我的桌面上，你可以把它保存到任何你想要的。

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

4）在调用SendEmail.bat的调度器中创build一个任务

Answer 2

您应该首先检查Outlook是否正在运行，如果是，请附加到它，而不是创build一个新的会话：

 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 Polygenisbuild议的VBScript都正常执行。