Outlook回复,包含各个收件人姓名(原始电子邮件的发件人姓名)

时间:2017-09-07 21:04:27

标签: vba email outlook outlook-vba

我在下面的Outlook VBA中创建了一个宏,回复时将发件人的第一个名称添加到问候语中,为正文添加一些文本,并在我想要的字体中添加签名。

我需要帮助的是让宏拉出发件人的所有名称,为他们分配一个值,然后我可以将其放在电子邮件正文的其他位置。如果无法做到这一点,我会满足于将所有名字都放入问候语中,尽管最好能够移动名字。

示例:发件人是Name1;名称2 目前,这个宏只会拉出Name1(给出“Dear Name1”),但是 我想至少得到“亲爱的名字1和名字2”。 Best可以将Name1放在问候语中,然后将Name2放在文本正文中。

我相信我已经尽我所能,现在请求专家帮助!谢谢!!

Sub AutoAddGreetingtoReply()
Dim oMail As MailItem
Dim oReply As MailItem
Dim GreetTime As String
Dim strbody As String
Dim SigString As String
Dim Signature As String
Dim R As Outlook.Recipient
Dim strGreetName As String

Select Case Application.ActiveWindow.Class
       Case olInspector
            Set oMail = ActiveInspector.CurrentItem
       Case olExplorer
            Set oMail = ActiveExplorer.Selection.Item(1)
End Select




strbody = "<H3><B></B></H3>" & _
"<br><br><B></B>" & _
          "Please visit this website to view your transactions.<br>" & _
          "Let me know if you have problems.<br>" & _
          "<A HREF=""http://www.google.com"">Questions</A>" & _
          "<br><br>Thank you"

          SigString = Environ("appdata") & _
            "\Microsoft\Signatures\90 Days.htm"

On Error Resume Next

If Dir(SigString) <> "" Then
          strGreetName = Left$(oMail.SenderName, InStr(1, oMail.SenderName, " ") - 1)
End If

If Dir(SigString) <> "" Then
    Signature = GetBoiler(SigString)
Else
    Signature = ""
End If

Set oReply = oMail.ReplyAll

With oReply
    .CC = ""
    .HTMLBody = "<Font Face=calibri>Dear " & strGreetName & "," & R1 & strbody & "<br>" & Signature
    .Display
End With

End Sub

1 个答案:

答案 0 :(得分:0)

给定一个字符串“First Last”,然后像这样获取字符串的右侧

sndrName = oMail.SenderName
lastName = right(sndrName, len(sndrName) - InStr(1, sndrName, " "))

使用代码中的格式:

strGreetName = Left$(oMail.SenderName, InStr(1, oMail.SenderName, " ") - 1)
lastName = right(oMail.SenderName, len(oMail.SenderName) - InStr(1, oMail.SenderName, " "))

如果文本中有空格,则InStr返回位置。 https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/instr-function

原始邮件有一个发件人。 ReplyAll有收件人,包括原始邮件发件人。

Option Explicit

Private Sub ReplyFirstNames()

Dim oMail As mailitem
Dim oReply As mailitem

Dim strGreetName As String
Dim strGreetNameAll As String

Dim i As Long

Select Case Application.ActiveWindow.Class
    Case olInspector
        Set oMail = ActiveInspector.currentItem
    Case olExplorer
        Set oMail = ActiveExplorer.Selection.Item(1)
End Select

Set oReply = oMail.ReplyAll

With oReply

    Debug.Print "The reply all recipients are:"

    For i = 1 To .Recipients.count
        Debug.Print .Recipients(i)

        ' Given the format First Last
        strGreetName = Left(.Recipients(i), InStr(1, .Recipients(i), " ") - 1)
        strGreetNameAll = strGreetNameAll & strGreetName & ", "
    Next i

    Debug.Print strGreetNameAll
    ' remove extra comma and space from end
    strGreetNameAll = Left(strGreetNameAll, Len(strGreetNameAll) - 2)
    Debug.Print strGreetNameAll

    .htmlbody = "<Font Face=calibri>" & strGreetNameAll & .htmlbody
    .Display

End With

End Sub