使用 VBScript 发送电子邮件，但将已发送项目保留为未读？

Question

我在几年前创建了一个 Excel 文档，其中列出了我们系统中用于发送电子邮件的供应商列表。当时，我们使用的是 Lotus Notes，最近已经过渡到 Outlook。我不得不使用 Outlook 函数重写脚本。在当前的形式下，它可以工作，但在 Lotus 中，当他们发送电子邮件时，它们会出现在用户的已发送框中，为未读。显然，用户已经依赖此功能并将其用于不同的报告目的，所以我想知道我是否可以以某种方式修改代码以获得类似的结果。我怀疑我可以在 Outlook 中创建一些规则来处理这个问题，但这意味着为每个人创建相同的规则然后营业额。不会很漂亮。任何帮助将不胜感激。

        Sub SendWithLotus()

      Dim outobj, mailobj
      Dim strFileText
      Dim objFileToRead
      Dim vaRecipient As Variant, vsMsg As Variant, vaCC As Variant, stSubject As Variant, vaBCC As Variant

        Const stTitle As String = "Preview?"
        If 1 = 1 Then
            If MsgBox("Did you already preview your message?", _
            vbYesNo + vbInformation, stTitle) = vbNo Then _
            Exit Sub
        End If
        Range("C2:C74").Select
        Selection.Sort Key1:=Range("C2"), Order1:=xlAscending, Header:=xlNo, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal
        Range("A1").Select
        Dim a As Integer
        a = 0
    Dim i As Integer
    i = 2
    Do Until IsEmpty(Range("C" & i).Value)

    vaRecipient = Range("D" & i).Value
    Range("A41").Value = Range("F" & i).Value
    vaMsg = Range("A83").Value
    vaCC = Range("A78").Value
    vaBCC = Range("H" & i).Value
    stSubject = Range("E" & i).Value
    stAttachment = Range("A113").Value
    stAttachment2 = Range("A114").Value
    stAttachment3 = Range("A115").Value
    stAttachment4 = Range("A116").Value
    stAttachment5 = Range("A117").Value

      Set outobj = CreateObject("Outlook.Application")
      Set mailobj = outobj.CreateItem(0)


        With mailobj
        .To = vaRecipient
         If Range("B40").Value = "Yes" Then
                .cc = vaCC
            End If
        .bcc = vaBCC
        .Subject = stSubject
        .Body = vaMsg
                'Add attachments
        If stAttachment <> "" Then
        .Attachments.Add (stAttachment)
        End If

        If stAttachment2 <> "" Then
        .Attachments.Add (stAttachment2)
        End If

        If stAttachment3 <> "" Then
        .Attachments.Add (stAttachment3)
        End If

        If stAttachment4 <> "" Then
        .Attachments.Add (stAttachment4)
        End If

        If stAttachment5 <> "" Then
        .Attachments.Add (stAttachment5)
        End If
        .Send

      End With

      'Clear the memory
      Set outobj = Nothing
      Set mailobj = Nothing

           a = a + 1

    'Activate Excel for the user.
        AppActivate "SendWithOutlook"
            i = i + 1
Loop
        Range("A41").Value = ""
MsgBox "You have successfully sent " & a & " email(s).  Danny is Awesome.", vbInformation

    End Sub

Answer 1

您可以在已发送的项目文件夹中捕获Items.ItemAdd 事件并将MailItem.Unread 属性设置为true。 MailItem 将作为参数传递给您的事件处理程序。