Send emails using VBScript, but leave the Sent Item as Unread?

Question

I created an Excel document years ago which runs through a list of vendors we have in our system to send email messages. At the time, we were using Lotus Notes & have recently transitioned to Outlook. I had to rewrite the script, using Outlook functions. In it's current form, it works, but in Lotus when they emails were sent they appeared in a users Sent box, as unread. Apparently, users have become attached to this function & use it for different reporting purposes, so I'm wondering if I can somehow modify the code for similar results. I suspect I can create some rules in Outlook to handle this, but that would mean creating the same rule for each individual & then turnover. It wouldn't be pretty. Any help would be appreciated.

        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

You can catch the Items.ItemAdd event on the sent Items folder and set the MailItem.Unread property to true. MailItem will be passed as a parameter to your event handler.