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文件夹中捕获Items.ItemAdd事件，并将MailItem.Unread属性设置为true。 MailItem将作为参数传递给事件处理程序。

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

1 个答案: