Send personalised emails using a List in excel (advanced criteria and keep original formatting & Signature)

[HeyItsDizzy]

Hey guys I have a list of many clients and I want to send a nice email that looks like I have typed each email individually,

my biggest issues are that I lose my email signature when I enter anything into the body text, and the other thing is I can't get all the information from my "Sheet3" to show up in the email body, no 'cells()' or 'range()' statements I've Tried are working for me, the only information I can get is only from 'Sheet 3 - Cell A1'. Then if I put all the lines that I want to feed in, into cell A1, I then lost the visual formatting (text size and colour) that makes the email look nicer.

in the attached document my "Sheet3" looks exactly how I want it to look in the email can we keep this source formatting?

the below VBA code works for simple application but I feel like it is too simple for what I need. I cant for the life of me find the information I am after (I have left a few comments in the code for my own reference hopefully it helps you guys too)

document: https://drive.google.com/file/d/10jFu5H9QHEn9tbO_5Ldenn9mVrzP0BwY/view?usp=sharing

Sub SendPersonalisedEmail()

    Dim OutApp As Object
    Dim OutMail As Object
    Set OutApp = CreateObject("Outlook.Application")
    Dim intHowManyRows As Integer


With Application
    .ScreenUpdating = False
End With


intHowManyRows = Application.Range("A2:Q1000").CurrentRegion.Rows.Count ' <- this range doesnt seem to work, why?


For r = 1 To intHowManyRows
    
    Set OutMail = OutApp.CreateItem(0)
    With OutMail
        .To = Cells(r, 5).Value                             'replace with your company name
        .Subject = "G'day " & Cells(r, 2).Value & " From [my company name] "
        .CC = Cells(r, 12).Value
        '.Attachments.Add ("") ' -> If you want to add attachments
        '.Attachments.Add ("") ' -> If you want to add attachments
        '.Attachments.Add ("") ' -> If you want to add attachments
        'replace the text on next line within the 2 double quotation marks and input anything you want, then remove the apostrophy before the & symbol
        .Body = "Hi " & Cells(r, 9) & vbNewLine & vbNewLine & Cells(r, 16) & vbNewLine & Cells(r, 17) & vbNewLine & ThisWorkbook.Sheets("Sheet3").Range("A1")
        .Display  'Or use Send
        
    End With


Next r




Set OutMail = Nothing
Set OutApp = Nothing
Application.ScreenUpdating = True
End Sub

 

[Macropod]

Perhaps one of the Many-to-One Mail Merge add-ins, from:
Graham Mayor at http://www.gmayor.com/ManyToOne.htm; or
Doug Robbins at http://bit.ly/1hduSCB
will do what you want. As it is, it's not apparent what formatting you're having trouble preserving. Regardless, anything short of copy/paste won't preserve font formatting.

 

[HeyItsDizzy]

Thank you for your reply, if you download the excel sheet from the Google drive i shared you can see that on Sheet3 is how i want the emails to look,

is there any macro I can use that will still run down my list apply all the CC's and personalised blurbs *** it currently does, i would just like a visual signature in the body text and not just black text

 

[Macropod]

To be able to copy & paste the Excel formatting you'll need to use Outlook's WordEditor. See https://www.slipstick.com/developer/word-macro-apply-formatting-outlook-email/