使用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

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