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

Question

I have some macros and Task Scheduler to launch Excel at a specified time, update some tables, create PDF documents from those tables and then email those PDF documents to select individuals.

Sometimes the email gets stuck in the Outbox and does not send until I open up Outlook.

Here is the code for sending the email:

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

After this completes, the Private sub jumps back to the macros in this workbook and quits MS Excel with the CloseWorkbook Application.

My tools reference library in Outlook's VBA settings:

My Trust Settings:

Macro Settings:

"Enable all macros" selected

"Apply macro security settings to installed add-ins" selected

The idea is to have this program run in the early morning and have these emails in the inbox of select individuals by the time they come in to work.

Answer 1

Outlook, just like any other Office app, cannot run in a service(such as the Scheduler). That being said, you need to force Outlook to perform SendReceive and wait for it to complete. Call Namespace.SendAndReceive or retrieve the first SyncObject object from the Namespace.SyncObjects collection, call SyncObject.Start and wait fro the SyncObject.SyncEnd event to fire.

Answer 2

If anyone is still looking for an answer; this allows to actually send an email without opening outlook app.

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