首页 文章

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

提问于
浏览 次
2

我正在使用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
excel vba outlook

3 回答

  • 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 = "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的任务

    回复于
  • 1

    您应首先检查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

    导致错误的原因是我试图运行任务"with highest privileges"：

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

    回复于

相关问题