Automate reply-all (or forward) email and keep original text, then populate with excel data - excel VBA

[wiseone]

Hi All,

Been working on this today and not getting the desired results...so turning to the experts...hoping someone can help. I'm currently stuck trying to get the original message to appear, and the signature added. When I step through, the forward email works and populates with my signature, but then it is getting overwritten by the code below. (Adding my signature is my default outlook setting to replies and forwards.)

I have copied code from a few different sources over the day so I appreciate if you suggest better/cleaner way to do this.

I am trying to automate a reply (or forward) email which I can then populate with data from excel. The work flow would be as such:

1. Open the appropriate email in outlook.
2. Tab over to Excel.
3. Select appropriate row in excel.
4. Click Button.
5. Email is generated with correct data and appears as a normal reply to the email which was opened.
6. I click send.

Here are my requirements for the reply:

1. The email I am replying to will need to have the attachment (if any) included in the reply email. (this is why I started testing with forwarding). I know people will think it is strange to resend the original file, but it is a standard company practice......don't ask.

2. The email I am replying to will need to include all original recipients of the original email, in the correct fields (Same as a reply-all).

3. I need to append the CC and BCC with additional emails.

4. The email will need to keep the original text, similar to a normal reply, with the line that normally separates replies. (I am stumped here at the moment, original text is disappearing with my current code.

5. The Email will need to be HTML formatted due to the information being added.

6. The email signature of whoever uses the excel file should be included.

7. The original subject will get appended.

8. Looking for Excel VBA code, not Outlook VBA code.

Thanks in advance for your help!

'Base code Source: https://www.extendoffice.com/documents/excel/4656-excel-send-email-based-on-cell-value.html
'And here: https://www.mrexcel.com/board/threads/replying-to-a-selected-email-with-vba.1000382/

'This macro will create a forwarded email based on information in the Excel File

Option Explicit

Sub Confirmation_Email_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Dim Signature As String
    Dim SenderEmail As String
    Dim OriginalSubject As String
    Dim ForwardEmail As Object

    Const olMail = 43 'Not sure what 43 represents...just got this from code in links above
 
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = Get_Current_Outlook_Item(xOutApp) 'Replies to open email in outlook

'Use this syntax for HTML formatted text:
    xMailBody = "<p style='font-family:calibri;font-size:15'>Hello " & "NAME HERE, ENTER YOUR DATA HERE" & "</p>" & _
                           Signature  'Signature not working
 
    If Not xOutMail Is Nothing Then
            If xOutMail.Class = olMail Then
                SenderEmail = xOutMail.SenderEmailAddress 'Copy original sender
                OriginalSubject = xOutMail.Subject 'Copy Original Subject
             
                Set ForwardEmail = xOutMail.Forward
             
                With ForwardEmail
                    .Display
                    'Signature = xOutMail.HtmlBody 'This isnt working yet'
                    .To = SenderEmail 'Original sender added to forwarded message - Works!
                    .CC = "Enter emails here"
                    .BCC = "Enter emails here"
                    .Subject = "Appended text here" & OriginalSubject 'Subject appended - works!
                    .HtmlBody = xMailBody
                End With
            Else
                MsgBox "The current Outlook item is not an email"
            End If
        Else
            MsgBox "The current Outlook item is not an email"
    End If

    Set xOutMail = Nothing
    Set xOutApp = Nothing
    Set ForwardEmail = Nothing

End Sub



'This function gets the current active item in outlook.
Private Function Get_Current_Outlook_Item(OutlookApp As Object) As Object
     
    On Error Resume Next
 
    Select Case TypeName(OutlookApp.ActiveWindow)
        Case "Explorer"
            Set Get_Current_Outlook_Item = OutlookApp.ActiveExplorer.Selection.Item(1)
        Case "Inspector"
            Set Get_Current_Outlook_Item = OutlookApp.ActiveInspector.CurrentItem
        Case Else
            Set Get_Current_Outlook_Item = Nothing
    End Select
 
    On Error GoTo 0
 
End Function

 

[wiseone]

Anyone able to help with this?