Help! How do I attach an image with VBA

[ScottJ]

I developed VBA code that allows me to successfully embed images into emails that I send out using an Excel spreadsheet. Since the file names of these pics differ, I would like to pass these file names to oEmail.HTMLBody = "<IMG src='cid: using an argument (i.e., mail_pic) rather than hard code in a file name like ""Scott300X276.jpg" (see code below). Can someone please tell me the proper format to use in the <IMG scr='cid section of the code?

Thank you!



Sub SendAttachment(what_address As String, subject_line As String, mail_image As String, mail_pic As String)


Dim oApp As Outlook.Application
Dim oEmail As MailItem
Dim colAttach As Outlook.Attachments
Dim oAttach As Outlook.attachment

Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(olMailItem)
Set colAttach = oEmail.Attachments
Set oAttach = colAttach.Add(mail_image)

'****** PROBLEM WITH THIS PART OF CODE - Don't know the proper format to pass the "mail_pic" argument above to replace
' the oEmail.HTMLBody below to replace the filename "Scott300X276.jpg."


oEmail.Close olSave
oEmail.HTMLBody = "<IMG src='cid:Scott300X276_Sidney.jpg'>"


'oEmail.HTMLBody = "<IMG src='cid:(mail_pic)'>" <-- This does not work!

'******************************************

oEmail.To = what_address
oEmail.Subject = subject_line

oEmail.Send

Set oEmail = Nothing
Set colAttach = Nothing
Set oAttach = Nothing
Set oApp = Nothing
End Sub

[gmayor]

On the face of it and without being able to test with your data, I would have said that the syntax would need to be


oEmail.HTMLBody = "<IMG src='cid:" & mail_pic & "'>"

Personally I would do it differently, editing the message directly and use late binding to Outlook e.g.


Sub SendAttachment(what_address As String, subject_line As String, mail_image As String, mail_pic As String)

Dim oApp As Object
Dim oEmail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim colAttach As Object
Dim oAttach As Object

Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(0)
Set colAttach = oEmail.Attachments
Set oAttach = colAttach.Add(mail_image)
With oEmail
.BodyFormat = 2
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
oRng.InlineShapes.AddPicture Filename:=mail_pic
.To = what_address
.Subject = subject_line
.Display
.Send
End With
Set oEmail = Nothing
Set colAttach = Nothing
Set oAttach = Nothing
Set oApp = Nothing
End Sub

The only disadvantage is that the message must be displayed briefly which can be disconcerting, and the flicker when merging can cause problems for those who are troubled with flashing lights.

[ScottJ]

The fix you proposed worked like a charm. Thank you VERY much!! Wow, it works so well now.
Best regards!
Scott

[ScottJ]

Now that I can successfully embed an image into an Outlook e-mail using the code below, I would like to extend this a bit by being able to embed a video. Does anyone know how to modify the following code to do this?

************************************
Sub SendAttachment(what_address As String, subject_line As String, mail_image As String, mail_pic As String)


Dim oApp As Outlook.Application
Dim oEmail As MailItem
Dim colAttach As Outlook.Attachments
Dim oAttach As Outlook.attachment

Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(olMailItem)
Set colAttach = oEmail.Attachments
Set oAttach = colAttach.Add(mail_image)


oEmail.HTMLBody = "<IMG src='cid:" & mail_pic & "'>"
oEmail.To = what_address
oEmail.Subject = subject_line
oEmail.Send


Set oEmail = Nothing
Set colAttach = Nothing
Set oAttach = Nothing
Set oApp = Nothing
End Sub

*********************************

Thank you - Scott

[gmayor]

I would urge you strongly not to embed video files in e-mail messages. Videos typically feature huge file sizes that are not appropriate to e-mail, and even if Outlook will allow such a file, will tend to irritate recipients while their e-mail servers download the files - especially an issue if they view e-mail on a mobile telephone.

If you want to include video, then put the video somewhere the recipients can access it e.g. dropbox (http://db.tt/tqlLaHAS) or onedrive (https://onedrive.live.com/) and send them a link to the file. The previous code I posted can easily be modified to do that e.g.


Sub SendAttachment(what_address As String, subject_line As String, mail_image As String, video_link As String)

Dim oApp As Object
Dim oEmail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim colAttach As Object
Dim oAttach As Object
Dim strLinkText As String
strLinkText = "Click here for video."

Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(0)
Set colAttach = oEmail.Attachments
Set oAttach = colAttach.Add(mail_image)
With oEmail
.BodyFormat = 2
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
oRng.Text = "This is the body text of the message" & vbCr & vbCr & _
"The link appears below this text, and before the default signature." & vbCr & vbCr
oRng.collapse 0
wdDoc.Hyperlinks.Add Anchor:=oRng, _
Address:=video_link, _
SubAddress:="", _
ScreenTip:="", _
TextToDisplay:=strLinkText
.To = what_address
.Subject = subject_line
.Display
'.Send 'resurrect this line after testing.
End With
Set oEmail = Nothing
Set colAttach = Nothing
Set oAttach = Nothing
Set oApp = Nothing
End Sub

[ScottJ]

Thank you very much for the advise and also the code. It is most appreciated!
I hope you have a very nice new year.
Best regards,Scott

[ScottJ]

When I use the code below (as recommended above), I get a Run-time error 91 (Object variable or with block variable not set) error. Any idea where the problem is?
Thank you!


Sub SendVideo(what_address As String, subject_line As String, cover As String, video_link As String)


Dim oApp As Object
Dim oEmail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim colAttach As Object
Dim oAttach As Object
Dim strLinkText As String
strLinkText = "Click here for video."


Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(0)
Set colAttach = oEmail.Attachments
Set oAttach = colAttach.Add(cover)
With oEmail
.BodyFormat = 2
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0) '<------- ERROR AT THIS LINE
oRng.Text = "This is the body text of the message" & vbCr & vbCr & _
"The link appears below this text, and before the default signature." & vbCr & vbCr
oRng.collapse 0
wdDoc.Hyperlinks.Add Anchor:=oRng, _
Address:=video_link, _
SubAddress:="", _
ScreenTip:="", _
TextToDisplay:=strLinkText
.To = what_address
.Subject = subject_line
.Display
.Send 'resurrect this line after testing.
End With
Set oEmail = Nothing
Set colAttach = Nothing
Set oAttach = Nothing
Set oApp = Nothing


End Sub

[ScottJ]

When I use the code below (as recommended above), I get a Run-time error 91 (Object variable or with block variable not set) error. Any idea where the problem is?
Thank you!


Sub SendVideo(what_address As String, subject_line As String, cover As String, video_link As String)


Dim oApp As Object
Dim oEmail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
Dim colAttach As Object
Dim oAttach As Object
Dim strLinkText As String
strLinkText = "Click here for video."


Set oApp = CreateObject("Outlook.Application")
Set oEmail = oApp.CreateItem(0)
Set colAttach = oEmail.Attachments
Set oAttach = colAttach.Add(cover)
With oEmail
.BodyFormat = 2
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0) '<------- ERROR AT THIS LINE
oRng.Text = "This is the body text of the message" & vbCr & vbCr & _
"The link appears below this text, and before the default signature." & vbCr & vbCr
oRng.collapse 0
wdDoc.Hyperlinks.Add Anchor:=oRng, _
Address:=video_link, _
SubAddress:="", _
ScreenTip:="", _
TextToDisplay:=strLinkText
.To = what_address
.Subject = subject_line
.Display
.Send 'resurrect this line after testing.
End With
Set oEmail = Nothing
Set colAttach = Nothing
Set oAttach = Nothing
Set oApp = Nothing


End Sub

[gmayor]

It works for me, but change the errant line to


Set oRng = wdDoc.Range
oRng.collapse 1

and see if you fare any better.

[ScottJ]

No, still getting the same run-time error. I am wondering if it might be VBA Project references. Any idea which references must be checked or any other possible solutions?
Thank you!
Scott

[gmayor]

On the 24th December you reported that 'The fix you proposed worked like a charm. Thank you VERY much!! Wow, it works so well now.' The original macro used exactly the same method of accessing the message body range, so the implication is that something else is afoot. Reboot the PC. When it has restarted, before running Office, see http://www.gmayor.com/what_to_do_when_word_crashes.htm (http://www.gmayor.com/what_to_do_when_word_crashes.htm) and address any issue of orphaned temporary files. Then try again.