Отправить электронную почту, используя VBScript, но оставить отправленный элемент как непрочитанный? - PullRequest
Новая
       32

Отправить электронную почту, используя VBScript, но оставить отправленный элемент как непрочитанный?

0 голосов
/ 09 января 2019

Несколько лет назад я создал документ 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

1 Ответ

0 голосов
/ 10 января 2019

Вы можете перехватить событие Items.ItemAdd в отправленной папке Items и установить для свойства MailItem.Unread значение true. MailItem будет передано в качестве параметра вашему обработчику событий.

...