Sub Display()
Dim myMail As Outlook.MailItem
Dim myReply As Outlook.MailItem
Dim numItems As Integer
Dim mySelected As Selection
Dim i As Integer
Dim myText As String
Dim signature As String
signature = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(signature, vbDirectory) <> vbNullString Then
signature = signature & Dir$(signature & "*.htm")
Else:
signature = ""
End If
signature = CreateObject("Scripting.FileSystemObject").GetFile(signature).OpenAsTextStream(1, -2).ReadAll
Set mySelected = Outlook.ActiveExplorer.Selection
numItems = mySelected.Count
For i = 1 To numItems
Set myMail = mySelected(1)
Set myReply = myMail.Reply
myText = myMail.Body
myReply.Subject = "RO Finalized WF: Annual Review. Entity"
myText = "Hi All," & vbCrLf & vbCrLf & "Worflow ID:" & vbCrLf & vbCrLf & "infoinfoinfoinfo" & vbCrLf & vbCrLf & "Thanks," & vbCrLf & "Josh" & signature
myReply.HTMLBody = myText & vbCrLf & vbCrLf & myMail.HTMLBody
Myreply.display
Set myMail = Nothing
Set myReply = Nothing
Next
Set mySelected = Nothing
End Sub
上面的代码显示对您当前在Outlook中打开的电子邮件的回复,包括发送该邮件的人(放置在“收件人:”中)以及您在Outlook中当前打开的电子邮件的整个正文。
这是我要执行的操作,除了希望它不回复公开电子邮件,而是希望它专门按主题答复电子邮件。另外,我希望它包括Outlook中所有答复的确切内容(分隔每封电子邮件的行,并显示上一封电子邮件的“发件人:”,“已发送”,“收件人”,“抄送”,“主题:”)。同样,在MyText之后,vbCrLf并没有达到目的。
我也希望将抄送:从上一封电子邮件中放入我正在创建的电子邮件的抄送中。
我不是VBA专家,并且已经尝试了尽可能多的尝试。 谢谢您的提前帮助:)
我找到了另一个选项,并且代码显示在下面。 这将填充一封回复电子邮件,其中包含我需要的所有除自定义正文之外的内容。
Sub Display()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer
Dim IsExecuted As Boolean
signature = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(signature, vbDirectory) <> vbNullString Then
signature = signature & Dir$(signature & "*.htm")
Else:
signature = ""
End If
signature = CreateObject("Scripting.FileSystemObject").GetFile(signature).OpenAsTextStream(1, -2).ReadAll
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
IsExecuted = False
For Each olMail In Fldr.Items
If InStr(olMail.Subject, "checklist") <> 0 Then
If Not IsExecuted Then
With olMail.ReplyAll
.HTMLBody = "Dear All," & "<br>" & signature
End With
IsExecuted = True
olmail.ReplyAll.Display
End If
End If
Next olMail
End Sub
解决方案
Sub Display()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer
Dim IsExecuted As Boolean
signature = Environ("appdata") & "\Microsoft\Signatures\"
If Dir(signature, vbDirectory) <> vbNullString Then
signature = signature & Dir$(signature & "*.htm")
Else:
signature = ""
End If
signature = CreateObject("Scripting.FileSystemObject").GetFile(signature).OpenAsTextStream(1, -2).ReadAll
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
IsExecuted = False
For Each olMail In Fldr.Items
If InStr(olMail.Subject, "Subject") <> 0 Then
If Not IsExecuted Then
With olMail.ReplyAll
.HTMLBody = "<p>" & "Dear All," & "</p><br>" & signature & .HTMLBody
.Display
End With
IsExecuted = True
End If
End If
Next olMail
End Sub