使用VBA和自定义的正文/主题回复特定的Outlook电子邮件

时间:2018-07-03 20:57:46

标签: excel vba excel-vba outlook outlook-vba

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

0 个答案:

没有答案