Adding to ReplyAll email body

[Dr. Demento]

Hey folks,

I'm trying to figure out how to add text at the beginning of a ReplyAll email. When the first .Display runs, the .ReplyAll is good (however, the new text hasn't been added yet). However, when I try to add to the .Body, the original email text is deleted and I'm left with the new text only.

I've found a post that stated I need to run this (or something like this) from Outlook for it to work. Can anyone verify this or help me understand how I can accomplish this? The output needs to be a olFormatPlain.

Thanks y'all.

Option ExplicitSub email_fromXL()
' [URL]https://www.mrexcel.com/forum/excel-questions/990151-identify-specific-email-excel-sender-date-sent-subject-line.html#4[/URL]
' [URL]https://blogs.technet.microsoft.com/heyscriptingguy/2007/04/10/how-can-i-filter-outlook-messages-by-email-address/[/URL]
' ~~ Use following for Early Binding || [URL]http://answers.microsoft.com/en-us/office/forum/office_2010-customize/excel-vba-sending-email-with-outlook-2010-specify/4ae28948-0b01-4eb7-8f5f-10fbfa8f4df9?auth=1[/URL]
Dim olApp As New Outlook.Application  ' Early binding || https:msdn.microsoft.com/en-us/library/ff458119(v=office.11).aspx#odc_office_UseExcelObjectModeltoSendMail_MailingWorkbookasEmailAttachment
Dim olNS As Outlook.Namespace
  Set olNS = olApp.GetNamespace("MAPI")
Dim olFolder As Outlook.Folder
  Set olFolder = olNS.GetDefaultFolder(olFolderSentMail)
Dim olItems As Outlook.Items, _
    olFilteredItems As Outlook.Items
  Set olItems = olFolder.Items
  ' ~~ Only looks at items in Sent Mail that are from ME!! || [URL]https://blogs.technet.microsoft.com/heyscriptingguy/2007/04/10/how-can-i-filter-outlook-messages-by-email-address/[/URL] _
        Doesn't quite work!!
'  Set olFilteredItems = olItems.Restrict("[SenderEmailAddress] = 'TED@aol.com'")
Dim olMail As Outlook.MailItem, _
    olBody As Object
Dim vItem As Object
Dim cPosn As Long
Dim bln_FollowUpEmail As Boolean
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  ' ~~ Email to distro list
  For Each vItem In olItems  ' ~~ Only looks at items in Sent Mail that are from ME!!
    
    If vItem.Class = 43 Then  ' olMail = 43 || [URL]https://msdn.microsoft.com/en-us/library/office/ff863329.aspx[/URL]
      
      On Error Resume Next
        cPosn = InStr(vItem.Subject, "CASES | ")
        Debug.Print vItem.Subject
      On Error GoTo 0
      
      If cPosn > 0 Then
        ' ~~ for follow-up email
        If vItem.Subject Like "*CASES | " & Format(Date, "dd mmm yyyy") Then
          If DateValue(vItem.SentOn) = DateValue(Date) Then  ' ~~ existing email must be from today
            bln_FollowUpEmail = True  ' ~~ SECOND EMAIL, APPENDED to FIRST
            
  ' ####################  WHY WON'T IT REPLY ALL AND KEEP PREVIOUSLY SENT MAIL BODY  ####################
            Set olMail = vItem.replyall
            With olMail
              .BodyFormat = olFormatPlain
              .To = vbNullString
              .BCC = "Distro List"
              
              ' ~~ Assign text of Body to string variable -- HOW????
              Set olBody = olApp.ActiveExplorer.Selection(1)
              .Display
' DISPLAYS LIKE AS REPLY ALL!!!
                .Body = "Good Afternoon, " & vbNewLine & vbNewLine & _
                        "These are new CASES we have been notified about today:" & vbNewLine & vbNewLine & _
                         "New Case info" & _
                         vbNewLine & "email_Signature" & vbNewLine & vbNewLine & olBody ' (ERROR HERE!!!)
' IF I COMMENT OUT THE olBody, THE OLD BODY (REPLY) GETS ERASED!!
              .ReadReceiptRequested = False
              .Display
            End With 'vItem.replyall
            
            Exit For
          
          End If 'ReplyAll criteria (SentOn)
        End If 'vItem.Subject
      End If 'cPosn
    End If 'TypeName(vItem)
  Next vItem
End Sub

 

[Dr. Demento]

Bump