简体   繁体   中英

Excel VBA code throws run-time error 429 while sending Outlook email using Task Scheduler

I'm using Excel VBA macro to send automated emails (Outlook 2013) which runs with Windows Task Scheduler (I'm using batch file to do that) at specified time every day. When I run my macro without Task Scheduler it executes normally (emails are sent), but when I use Task Scheduler for that I receive "run-time error 429", this only happens when the VBA macro tries to create Outlook object:

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

The above error only happens if the Outlook application is open on the computer. Now what I don't understand is:

  1. Why does the macro work normally WITHOUT Task Scheduler (Despite Outlook being open or not) and why doesn't it work there?

  2. How to make the whole process execute using Task Scheduler and not to depend on Outlook app being open or closed? (ie I want the macro to run no matter which applications are open/closed).

Advice would be highly appreciated.

Edit: Here is the VBScript code I'm using to execute macro (in repsonse to LS_ᴅᴇᴠ's question):

    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

The reason which was resulting in error was that I was trying to run the task "with highest privileges":

This was apparently not feasible in my environment, so when I unchecked it both the VBScript I was using and VBScript suggested by @Nikolaos Polygenis execute normally.

You should first check if Outlook is running and if so, attach to it and not creating a new session:

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

Please follow the below:

1) Write in an excel file which saved as SendEmail.xlsm, your 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 = "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) Open a notepad write this Code and save it as 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) Open a notepad write this code and save as bat (SendEmail.bat),I have saved it on my desktop, you can save it everywhere you want.

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

4) Create a task in the scheduler which calls the SendEmail.bat

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM