使用任务计划程序通过 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 = "[email protected]"
        .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 应用程序的情况下实际发送电子邮件。

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

Answer 2

Outlook 与任何其他 Office 应用程序一样，无法在服务（例如计划程序）中运行。 话虽这么说，您需要强制 Outlook 执行 SendReceive 并等待它完成。调用

Namespace.SendAndReceive

或从

SyncObject

集合中检索第一个

Namespace.SyncObjects

对象，调用

SyncObject.Start

并等待

SyncObject.SyncEnd

事件触发。