VBA Personalize Outlook Email

[whew1110]

Hi everyone!

I am trying to customize the body of an email blast. Ideally I would like to email to have "Dear ____" with each one specific to the client. I am able to get the text in however I would like to use HTML to format the font size, color, etc.

-----------------------------------------------------------------------------------------------------------
Sub emailreporting()

Dim emailaddy As String
Dim emailcc As String
Dim acctname As String
Dim acctno As String
Dim EmailSubject As String
Dim dateday As String
Dim datemonth As String
Dim dateyear As String
Dim verifyday As String
Dim resp As String
Dim resptype As String
Dim Dear As String


Cells.Find(What:="Email Subject").Activate
EmailSubject = ActiveCell.Offset(0, 1).Value
resptype = ActiveCell.Offset(1, 1).Value
Cells.Find(What:=resptype & "Dear", SearchOrder:=xlByColumns).Activate
ActiveCell.Offset(1, 0).Select


Do

acctname = ActiveCell.Offset(0, -1).Value
acctno = ActiveCell.Value
emailaddy = ActiveCell.Offset(0, 1).Value
emailcc = ActiveCell.Offset(0, 2).Value
Dear = ActiveCell.Offset(0, 0).Value

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

Set OutMail = OutApp.CreateItem(0)

On Error Resume Next
With OutMail
.To = emailaddy
.cc = emailcc
.Subject = EmailSubject
.HTMLBody = Dear & "

-----------------------------------------------------------------------------------------------------------

You see how String Dear is used at the beginning of .HTMLBody. How can I move the string Dear into the html coding so that it will have the same font color, size, etc. applied. currently it is outside of the HTML style script. or if there is an alternate way to get the "Dear ___", formatted to the same was as the rest of the email body.

thanks!!!!

[westconn1]

i think a simple solution would be to put a placeholder within the html then use replace to place the name in place of the placeholder

[gmayor]

I wouldn't do it like that. For a start you appear to have the the Outlook app creation in a loop. You only need to open Outlook once, so put that outside the loop. Instead of creating a new app each time, check if it is already open and if so, use the open app as that is much quicker:

On Error Resume Next
    Set OutApp = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        Set OutApp = CreateObject("Outlook.Application")
    End If
    On Error GoTo 0

As for the message itself, you can use the Outlook e-mail editor to edit the message body and retain your automatic signature related to the sending account. In the example below I have set a range (oRng)to the start of the message body. You can add text to oRng and format it using Word's range formatting parameters

I'll assume your cell references are correct as I don't have access to your worksheet.

You will need some more declarations:

Dim wdDoc As Object
Dim oRng As Object
Dim olInsp As Object

Set OutMail = OutApp.CreateItem(0)
    acctname = ActiveCell.Offset(0, -1).Value
    acctno = ActiveCell.Value
    emailaddy = ActiveCell.Offset(0, 1).Value
    emailcc = ActiveCell.Offset(0, 2).Value
    Dear = "Dear John,"
    With OutMail
        .To = emailaddy
        .cc = emailcc
        .Subject = EmailSubject
        .BodyFormat = 2        '(olFormatHTML)
        Set olInsp = .GetInspector
        Set wdDoc = olInsp.WordEditor        'Use the Word message editor
        Set oRng = wdDoc.Range(0, 0)        'The start of the message body
        With oRng
            'populate the range
            .Text = Dear & vbCr & "The text"
        End With
        .Display 'do not omit
        '.Send 'restore when you are happy with the result
    End With