[英]Excel VBA code throws run-time error 429 while sending Outlook email using Task Scheduler
我正在使用 Excel VBA 宏在每天指定的时间发送自动电子邮件(Outlook 2013),该电子邮件与 Windows 任务计划程序一起运行(我正在使用批处理文件来执行此操作)。 当我在没有任务计划程序的情况下运行我的宏时,它会正常执行(发送电子邮件),但是当我为此使用任务计划程序时,我收到“运行时错误 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@email.com"
.CC = ""
.BCC = ""
.Subject = "subj"
.Body = "body"
.Attachments.Add ActiveWorkbook.FullName
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
只有在计算机上打开 Outlook 应用程序时才会发生上述错误。 现在我不明白的是:
为什么宏在没有任务计划程序的情况下正常工作(无论 Outlook 是否打开),为什么它在那里不起作用?
如何使用任务计划程序执行整个过程而不依赖于打开或关闭 Outlook 应用程序? (即,无论打开/关闭哪些应用程序,我都希望宏运行)。
建议将不胜感激。
编辑:这是我用来执行宏的 VBScript 代码(响应 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
您应该首先检查 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
请遵循以下说明:
1)写入一个保存为SendEmail.xlsm的excel文件,你的子:
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@email.com"
.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
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.