Insert Logo (image) on draft emails VBA

[Bambino86]

Hi,

I have bunch of emails (around 50 emails) sitting on draft folder and I would like to embed a logo to all emails which is saved to my documents. The logo should be on the top left side of the body email. I am not very knowledgeable with VBA so I hope someone can help me with the codes.

Thanks.

[gmayor]

For the future it might make more sense to create stationery or a signature with your logo, however the following should work. Change the path of the logo ("D:\My Documents\My Pictures\GMLogo.png") to the path of the logo you wish to use.


Sub AddLogo()
'Graham Mayor - http://www.gmayor.com - Last updated - 20 Sep 2017
Dim olFolder As Outlook.Folder
Dim olItems As Outlook.Items
Dim olItem As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim oShape As Object

Dim i As Long
On Error Resume Next
Set olFolder = Session.GetDefaultFolder(olFolderDrafts)
Set olItems = olFolder.Items
For i = olItems.Count To 1 Step -1
Set olItem = olItems(i)
With olItem
.BodyFormat = olFormatHTML
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
.Display
Set oRng = wdDoc.Range(0, 0)
Set oShape = oRng.InlineShapes.AddPicture _
(fileName:="D:\My Documents\My Pictures\GMLogo.png", _
LinkToFile:=False, _
SaveWithDocument:=True)
Set oRng = oShape.Range
oRng.collapse 0
oRng.Text = vbCr
.Save
.Close 1
End With
Next i

lbl_Exit:
Set olFolder = Nothing
Set olItems = Nothing
Set olItem = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub

[Bambino86]

Thanks. It works perfectly