Extract Names from Senders in Reply and Add to Greeting Outlook VBA

[learningVBA321]

Hello everyone,

I posted this in the non-excel forum to no avail, so hoping it will get traction here, as this forum notes you can post VBA-related questions and that is what this is.

I have some code here that currently works to create a reply, take the sender's name, and put it in the greeting. It also adds wording for the body and then a signature. What I need to do is get Outlook to pull all the names from the sender field and be able to add them to the reply as well.

So, you have the sender as Name1; Name 2 in the from fields from the original received email (they become the To fields in the reply).
I currently get this in my reply using the code below: Dear Name1,

I want to have it get Dear Name1 but then also assign a value to Name2. One that I could either put somewhere in the body (preferable) or at least have it add to the greeting. I know I can pull them as a string, but I want to treat each name individually, as I might need to put them in a place other than just the greeting.

I got some of this from Ron DeBruin and then added my own and some other coding. Can anyone help?

Thanks!

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
   
     
    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"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If
   
    Set oReply = oMail.ReplyAll
 
    With oReply
        .CC = ""
        .HTMLBody = "<Font Face=calibri>Dear " & oMail.SenderName & "," & r1 & strTo & strbody & "<br>" & Signature
        .Display
    End With
    
    End Sub

 

[Worf]

Hello

I don’t have Outlook configured on this computer, so my testing was limited. Anyway, see the example below.
Do you have the “sent on behalf of” information on the message? Do you have users with delegated access?

' Outlook module
Sub AutoAddGreetingtoReply()
Dim oMail As MailItem, oReply As MailItem, GreetTime$, a
Dim strbody$, SigString As String, Signature$, R As Recipient, i%

Select Case Application.ActiveWindow.Class
    Case olInspector
        Set oMail = ActiveInspector.CurrentItem
    Case olExplorer
        Set oMail = ActiveExplorer.Selection.Item(1)
End Select
strbody = "Please visit this website to view your transactions." & _
"Let me know if you have problems." & vbLf & "Questions"
SigString = Environ("appdata") & "\Microsoft\Signatures\90 Days.htm"
If Dir(SigString) <> "" Then
    Signature = (SigString)
Else
    Signature = ""
End If

MsgBox oMail.SenderEmailAddress & vbLf & oMail.SenderName

For i = 1 To oMail.Recipients.Count
    MsgBox oMail.Recipients(i).Address      ' individual address
Next
a = Split(oMail.To, ";")                    ' list separated by a ;
For i = LBound(a) To UBound(a)
    MsgBox a(i)                             ' individual address
Next
End Sub

 

[learningVBA321]

Hello and thank you so much for the reply! To answer your questions, no to both. These are just regular emails sent by the direct users. I tried your code and it opened up msgboxes showing a lot of information, but it does not execute a reply and insert the names. Is there perhaps a piece of code I could use from it to get to that end?

BTW, it was great when you joined DS9!

 

[learningVBA321]

Bumpskiruski.

 

[Worf]

That code was just an example. You said the message has multiple senders and I don´t have one like this to test.
We need to retrieve the list of senders, tell me if the code below does that.

' Outlook module
Public Sub DisplaySenderDetails()
Dim Explorer As Explorer, CurrentItem As Object, Sender As AddressEntry, Contact As ContactItem
Set Explorer = Application.ActiveExplorer
' Check whether any item is selected in the current folder.
If Explorer.Selection.Count Then
    ' Get the first selected item.
    Set CurrentItem = Explorer.Selection(1)
    ' Check for the type of the selected item as only the MailItem object has the Sender property.
    If CurrentItem.Class = olMail Then
        MsgBox GetSMTPAddress(CurrentItem)
        Set Sender = CurrentItem.Sender
        ' There is no sender if the item has not been sent yet.
        If Sender Is Nothing Then
            MsgBox "There's no sender for the current email", vbInformation
            Exit Sub
        End If
        Set Contact = Sender.GetContact
        If Not Contact Is Nothing Then
            ' The sender is stored in the contacts folder, so the contact item can be displayed.
            Contact.Display
        Else
            ' If the contact cannot be found, display the address entry in the properties dialog box.
            Sender.Details 0
        End If
    End If
End If
End Sub


Function GetSMTPAddress$(olkMsg As MailItem)
Dim olkSnd As AddressEntry, olkExu As ExchangeUser
Set olkSnd = olkMsg.Sender
If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then
    Set olkExu = olkSnd.GetExchangeUser
    GetSMTPAddress = olkExu.PrimarySmtpAddress
Else
    GetSMTPAddress = olkMsg.SenderEmailAddress
End If
Set olkSnd = Nothing:    Set olkExu = Nothing
End Function