延迟 Outlook 关闭，直到电子邮件发送完毕答案

【问题标题】：Delay Outlook from closing until emails have been sent延迟 Outlook 关闭，直到电子邮件发送完毕
【发布时间】：2019-11-05 18:20:11
【问题描述】：

我有一个 VBscript，它运行 SAP 并下载一个文件，然后在文件上运行一个宏，然后保存并发送电子邮件。

问题是我有一个包含 8 个电子邮件地址的列表来发送文件，但 Outlook 在关闭前只发送给 3-4 人。重新打开 Outlook 后，它将完成发送剩余的电子邮件。

有谁知道延迟 Outlook 关闭直到完成发送所有电子邮件的方法？

我尝试了等待脚本，但似乎没有解决问题。

我尝试在结束之前和之后使用 Wait 语句，就在之前 Set objOutlook = Nothing:

'sending e mail with attachment
set app = CreateObject("Excel.Application")
Set wb = app.Workbooks.Open ("B:\GLOBAL\2063-BASUS\WYANDOTTE\CMN\CM Supply Chain\CM Customer Care Team\HOM Reports\CM Hom Archive\HOM Contacts\HomContacts.xlsx")
'skip header row. set to 1 if you
'don't have a header row
set sh = wb.Sheets("Sheet1")
row = 1
email = sh.Range("A" & row)
LastRow = sh.UsedRange.Rows.Count
For r = row to LastRow
    If App.WorkSheetFunction.CountA(sh.Rows(r)) <> 0 Then 
        SendMessage email
        row = row + 1
        email = sh.Range("A" & row)
      End if
Next
wb.close
set wb = nothing
set app = nothing


Sub SendMessage(EmailAddress)

  ' Create the Outlook session.
  Set objOutlook = CreateObject("Outlook.Application")

  template = FindTemplate()

  ' Create the message.
  Set objOutlookMsg  = objOutlook.CreateItem(0)

  With objOutlookMsg
      ' Add the To recipient(s) to the message.
      Set objOutlookRecip = .Recipients.Add(EmailAddress)
      objOutlookRecip.resolve
      objOutlookRecip.Type = 1

     ' Set the Subject, Body, and Importance of the message.
     .Subject = "Todays Hom Report"
     .bodyformat = 3
     .Importance = 2  'High importance
     body = "Please do not reply to e mail as this is unmanned"


     if not isNull(AttachMentPath) then
       .Attachments.add "B:\GLOBAL\2063-BASUS\WYANDOTTE\CMN\CM Supply Chain\CM Customer Care Team\HOM Reports\hom_script\Hom Export\Hom Report.xlsx"
     end if

     .HTMLBody = body

     ' Should we display the message before sending?
     If DisplayMsg Then
         .Display
     Else
         .Save
         .Send
     End If
    End With
    Set objOutlook = Nothing
End Sub

Function FindTemplate()
    Set OL = GetObject("", "Outlook.Application")
    set Drafts = OL.GetNamespace("MAPI").GetDefaultFolder(16)
    Set oItems = Drafts.Items

    For Each Draft In oItems
        If Draft.subject = "Template" Then
            FindTemplate = Draft.HTMLBody
            Exit Function
        End If
    Next
End Function

没有错误消息。它会向大约 3-4 个电子邮件地址发送电子邮件，并且在我重新打开 Outlook 之前不会完成其余的发送。这将在带有调度程序的无人服务器上运行。

【问题讨论】：

嗨，汤姆。我看到您是 Stack Overflow 的新手，所以我想说欢迎来到社区。代码的格式是否正确？如果没有，您可以编辑它，并将所有代码放在三个反引号 ` ` 中。反引号位于代码的开头和结尾。我希望这能让阅读更容易。最好的祝福。
因此，如果我复制并粘贴其中的代码，我会添加 ``` 然后添加所有代码，然后添加 ``` 会导致代码格式正确吗？我必须做的是在每行之间放置一个空格，以使其正确显示。如果可行，我可以更改
谢谢汤姆。代码现在可读并且对读者/审阅者来说很清楚。

标签： excel email vbscript outlook delay

【解决方案1】：

您可以获取发件箱文件夹并检查其中还剩下多少电子邮件：

Dim objNamespace
Dim objOutboxItems

Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objOutboxItems = objNamespace.GetDefaultFolder(4).Items

等到发件箱中的 objOutboxItems.Count 为 0 后再将 Outlook 变量设置为 Nothing。

【讨论】：

邮件可能卡在发件箱文件夹中。此外，您很可能需要一个可以定期检查发件箱文件夹的计时器。

【解决方案2】：

有几种方法可以实现所需的功能：

SyncObject.SyncEnd 事件在 Microsoft Outlook 使用指定的发送/接收组完成同步用户文件夹后立即触发。因此，您可以确保一切都与远程服务器同步。
MailItem.SaveSentMessageFolder 属性返回或设置一个 Folder 对象，该对象表示发送后将保存电子邮件副本的文件夹。默认情况下，目标文件夹为Sent Items 文件夹。因此，您可以等到所有电子邮件都放入该文件夹。

【讨论】：