在发送电子邮件之前延迟关闭Outlook

Question

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

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

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

我尝试了一个等待脚本，但它似乎不能解决问题。

我尝试在end前后使用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才会发送完剩余的邮件。这将在具有调度程序的无人值守服务器上运行。

Answer 1

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

Dim objNamespace
Dim objOutboxItems

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

请等待发件箱中的objOutboxItems.Count为0，然后再将Outlook变量设置为空。

Answer 2

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

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