vba - Sending an auto-filled Outlook email template from Excel with multiple cell text body and additional text formatting

Question

I have an email template saved in Outlook. I send this email out many times a day. Each email I send is formatted with bold, colored text, the company logo, and unique information for that recipient.

The unique information is generated in excel and so what I have been manually copying and pasting the excel information into the Outlook template.

I want to figure out a way to get excel to auto-populate the template for me, including the main recipient, the cc recipient, subject, and attachment, and the cells pasted into the body of the email.

I know there is a way through mailings in Microsoft Word, but I can't figure out how to get it to automate completely. Then excel will do everything, but it ignore all formatting in the text body and I cant get it to select multiple cells for the text body.

I don't even know where to begin with this one. Below is the basic VBA for sending an email on outlook. But of course, the range for the email body doesnt work

Sub SupplierTestingEmail()

   Dim olApp As Outlook.Application
      Set olApp = CreateObject("Outlook.Application")

        Dim olMail As Outlook.MailItem
        Set olMail = olApp.CreateItem(olMailItem)

        olMail.To = Range("B1")
        olMail.Subject = Range("B2")
        olMail.Body = Range("A1:C5")
        olMail.Display

End Sub

I want the email to include the following things

1) a range of cells for the body
2) the company logo
3) Colored text
4) referenced cells
5) an attachment
6) a carbon copy, I need to CC someone.

Answer 1

To Preserves original formatting once you copy the range, work with Word object model with MailItem.GetInspector Property (Outlook) and then paste it as wdFormatOriginalFormatting WdRecoveryType Enumeration (Word)

---

Example

Option Explicit
Public Sub Example()
' add ref - tool -> references - > Microsoft Outlook XX.X Object Library
    Dim olApp As Outlook.Application
    Set olApp = New Outlook.Application

    Dim Email As Outlook.MailItem
    Set Email = olApp.CreateItem(0)

' add ref - tool -> references - > Microsoft Word XX.X Object Library
    Dim wdDoc As Word.Document '<=========
    Set wdDoc = Email.GetInspector.WordEditor

    Dim Sht As Excel.Worksheet
    Set Sht = ThisWorkbook.Worksheets("Sheet1")

    Dim rng As Range
    Set rng = Sht.Range("A4:H16").SpecialCells(xlCellTypeVisible)
        rng.Copy

    With Email
        .To = Sht.Range("C1")
        .Subject = Sht.Range("B1")
        .Display

         wdDoc.Range.PasteAndFormat Type:=wdFormatOriginalFormatting
    End With

End Sub

---

Excel

---

Outlook