Email using VBA in Excel not working

[VbaHell]

Hello all

I hope you can help on this issue please

I am using Outlook 2016 from the Office 365 program

I have three email accounts set up and I am trying to run this code to automatically send out emails from the primary email account

I know this works ok with Microsoft office Outlook but it will not work in my Outlook 2016

Can anyone spot the mistake here please



[Sub SendEmail()


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:G24")) Is Nothing Then
strHTMLBody = strHTMLBody & cell.Value
Else
strHTMLBody = strHTMLBody & "<b><i>" & cell.Value & "</b></i>"
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 = "Bla Bla bla"
.Attachments.Add "C:\Users\Joe Bloggs\Pictures.jpg"
.HTMLBody = "Attention " & Cells(cell.Row, "A").Value & strHTMLBody & "<br><img src=""cid:AGL.jpg"">"
.Send
End With
'On Error GoTo 0
Set OutMail = Nothing
End If
Next cell

cleanup:
Set OutApp = Nothing
Application.ScreenUpdating = True




End Sub]