使用任务计划程序通过 VBA 发送的电子邮件卡在发件箱中

Question

我有一些宏和任务计划程序可以在指定的时间启动 Excel，更新一些表格，从这些表格创建 PDF 文档，然后通过电子邮件发送这些 PDF 文档以选择个人。

有时电子邮件会卡在发件箱中，直到我打开 Outlook 才会发送。

这是发送电子邮件的代码：

Option Explicit

Public strFileName As String

Sub EmailPDFAsAttachment()
'This macro grabs the file path and stores as a concatenation/variable. Then it emails the file to whomever you specify.
' Works in Excel 2000, Excel 2002, Excel 2003, Excel 2007, Excel 2010, Outlook 2000, Outlook 2002, Outlook 2003, Outlook 2007, Outlook 2010.
' This example sends the last saved version of the Activeworkbook object .

    Dim OutApp As Object
    Dim OutMail As Object
    Dim FilePath As String

    'This part is setting the strings and objects to be files to grab with their associated filepath. (e.g. FilePath is setting itself equal to the text where we plan to set up each report)

    FilePath = "\\"ServerNameHere"\UserFolders\_AutoRep\DA\PDFs\SealantsVS1SurfaceRestore\" _
    & strFileName & ".pdf"

    With Application
        .EnableEvents = True
        .ScreenUpdating = True
  '  End With

    'Below is where it creats the actual email and opens up outlook.
    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
   ' ******Make sure to set the .To to only recipients that are required to view it. Separate email addresses with a semicolon (;).
   ' Current distribution list:
   ' 

    With OutMail
        .To = "example@Example.com"
        .CC = ""
        .BCC = ""
        .Subject = strFileName

        .HTMLBody = "Hello all!" & "<br>" & _
        "Here is this month's report for the Sealants vs Surface Restore. It goes as granular as to by show results by provider." & "<br>" & _
         "Let me know what you think or any comments or questions you have!" & "<br>" & _
         vbNewLine & .HTMLBody
         'Here it attached the file, saves the email as a draft, and then sends the file if everything checks out.
        .Attachments.Add FilePath
        .Send

    End With
    On Error GoTo 0

   ' With Application
   '    .EnableEvents = True
   '   .ScreenUpdating = True
    End With
'This closes out the Outlook application.
    Set OutMail = Nothing
    Set OutApp = Nothing

End Sub

完成后，Private sub 跳回到此工作簿中的宏并使用 CloseWorkbook 应用程序退出 MS Excel。

我在 Outlook 的 VBA 设置中的工具参考库：

我的信任设置：

宏设置：

选择了“启用所有宏”

已选择“将宏安全设置应用于已安装的加载项”

我们的想法是让这个程序在清晨运行，并在他们上班时将这些电子邮件发送到选定人员的收件箱中。

Answer 1

Outlook 与任何其他 Office 应用程序一样，无法在服务（例如计划程序）中运行。 也就是说，您需要强制 Outlook 执行 SendReceive 并等待它完成。 调用Namespace.SendAndReceive或从Namespace.SyncObjects集合中检索第一个SyncObject对象，调用SyncObject.Start并等待SyncObject.SyncEnd事件触发。

Answer 2

如果有人还在寻找答案； 这允许在不打开 Outlook 应用程序的情况下实际发送电子邮件。

Dim mySyncObjects As Outlook.SyncObjects
Dim syc As Outlook.SyncObject
Set mySyncObjects = Outlook.Application.GetNamespace("MAPI").SyncObjects
Set syc = mySyncObjects(1)
syc.start