Send email with bold font using VBA

[VbaHell]

Hello all

I hope you can help on this please

This code sends out emails from the contact list which works fine and takes the body of the email content from range G1:G53. What I am trying to do is change the font to Bold from Range G14:G23.

Any ideas please

[Sub Test1()

Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim strbody As String Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")

For Each cell In Range("G1:G53")
strbody = strbody & cell.Value & vbNewLine
Next
On Error GoTo cleanup
For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And _
LCase(Cells(cell.Row, "C").Value) = "yes" Then
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Testing"
.Body = "Attention " & Cells(cell.Row, "A").Value & vbNewLine & vbNewLine & strbody
.Send
End With
On Error GoTo 0
Set OutMail = Nothing
End If
Next cell
cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True

End Sub]

 

[Domenic]

You'll need to use the HTMLBody property, along with HTML formatting tags. Note that I've commented out "On Error Resume Next" and "On Error GoTo 0" since you already have "On Error GoTo cleanup" to handle errors. Also, note that a space has been added after each occurrence of < to prevent this Board from interpreted it as HTML code. Therefore, remove those spaces from the code.

[COLOR=darkblue]Sub[/COLOR] Test1()

    [COLOR=darkblue]Dim[/COLOR] OutApp [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] OutMail [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Object[/COLOR]
    [COLOR=darkblue]Dim[/COLOR] cell [COLOR=darkblue]As[/COLOR] Range
    [COLOR=darkblue]Dim[/COLOR] strHTMLBody [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]String[/COLOR]
    
    Application.ScreenUpdating = [COLOR=darkblue]False[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] OutApp = CreateObject("Outlook.Application")
    
    strHTMLBody = ""
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] cell [COLOR=darkblue]In[/COLOR] Range("G1:G53")
        [COLOR=darkblue]If[/COLOR] Intersect(cell, Range("G14:G23")) [COLOR=darkblue]Is[/COLOR] [COLOR=darkblue]Nothing[/COLOR] [COLOR=darkblue]Then[/COLOR]
            strHTMLBody = strHTMLBody & cell.Value & "< br>"
        [COLOR=darkblue]Else[/COLOR]
            strHTMLBody = strHTMLBody & "< b>" & cell.Value & "< /b>< br>"
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR]
    
    [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] cleanup
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] cell [COLOR=darkblue]In[/COLOR] Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        [COLOR=darkblue]If[/COLOR] cell.Value [COLOR=darkblue]Like[/COLOR] "?*@?*.?*" And _
            LCase(Cells(cell.Row, "C").Value) = "yes" [COLOR=darkblue]Then[/COLOR]
                [COLOR=darkblue]Set[/COLOR] OutMail = OutApp.CreateItem(0)
                [COLOR=green]'On Error Resume Next[/COLOR]
                [COLOR=darkblue]With[/COLOR] OutMail
                    .To = cell.Value
                    .Subject = "Testing"
                    .HTMLBody = "Attention " & Cells(cell.Row, "A").Value & "< br>< br>" & strHTMLBody
                    .Send
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
                [COLOR=green]'On Error GoTo 0[/COLOR]
                [COLOR=darkblue]Set[/COLOR] OutMail = [COLOR=darkblue]Nothing[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] cell
    
cleanup:
    [COLOR=darkblue]Set[/COLOR] OutApp = [COLOR=darkblue]Nothing[/COLOR]
    Application.ScreenUpdating = [COLOR=darkblue]True[/COLOR]


[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]

Hope this helps!

 

[VbaHell]

Hi Domenic

thanks very much for your reply, i used your concept but coded the < br> in the spreadsheet so I could format each line spacing as I wanted, now works great thanks to you

on another area is it possible to add a jpeg after the signature please

 

[Domenic]

You're very welcome, glad I could help!

To add an image to an email, first the jpg is attached to the email, and then HTML code is used to insert the image within the body of the email...

Sub Test1()

    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range
    Dim strHTMLBody As String
    
    Application.ScreenUpdating = False
    
    Set OutApp = CreateObject("Outlook.Application")
    
    strHTMLBody = ""
    For Each cell In Range("G1:G53")
        If Intersect(cell, Range("G14:G23")) Is Nothing Then
            strHTMLBody = strHTMLBody & cell.Value & "< br>"
        Else
            strHTMLBody = strHTMLBody & "< b>" & cell.Value & "< /b>< br>"
        End If
    Next
    
    On Error GoTo cleanup
    For Each cell In Columns("B").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
            LCase(Cells(cell.Row, "C").Value) = "yes" Then
                Set OutMail = OutApp.CreateItem(0)
                'On Error Resume Next
                With OutMail
                    .To = cell.Value
                    .Subject = "Testing"
[COLOR=#ff0000]                    .Attachments.Add "c:\users\domenic\pictures\sample.jpg"[/COLOR]
                    .HTMLBody = "Attention " & Cells(cell.Row, "A").Value & "< br>< br>" & strHTMLBody[COLOR=#ff0000] & "< br>< br>< img src=""cid:sample.jpg"">"[/COLOR]
                    .Send
                End With
                'On Error GoTo 0
                Set OutMail = Nothing
        End If
    Next cell
    
cleanup:
    Set OutApp = Nothing
    Application.ScreenUpdating = True


End Sub

Change the path and filename of the image, accordingly. Also, don't forget to remove the spaces after each "<".

Hope this helps!

 

[VbaHell]

Works great, thank you very much