Link to home
Start Free TrialLog in
Avatar of newparadigmz
newparadigmzFlag for United States of America

asked on

Excel copy picture into Outlook email

Just need simple generic code to copy an existing picture from a worksheet, opening a Outlook email, and then paste the picture into the body, along with other fields (to:, subject:, etc..).

Should work with Excel 2003 :)

Thanks!
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

You may try something like this.....
Change it as per your requirement.

Sub CopyPictureToOutlook()
Dim ws As Worksheet
Dim shp As Shape
Dim olApp As Object
Dim olMail As Object
Dim olInsp As Object
Dim wdApp As Object
Dim Doc As Object
Dim DocSel As Object
Application.ScreenUpdating = False

Set ws = ActiveSheet                'Sheet which contains the picture
Set shp = ws.Shapes("Picture 1")    'Picture name
shp.Copy
Set olApp = CreateObject("Outlook.Application")
Set olMail = olApp.CreateItem(0)

With olMail
    .To = "Email ID here"       'Recipient's email address
    .Subject = "Subject here"   'Subject line
    .display                    'Displays the email
    '.send                      'Uncomment to send the email
End With

Set olInsp = olMail.GetInspector
Set Doc = olInsp.WordEditor
Set wdApp = Doc.Application
Set DocSel = wdApp.Selection
DocSel.Paste
Set DocSel = Nothing
Set Doc = Nothing
Set wdApp = Nothing
Set olInsp = Nothing
Set olMail = Nothing
Set olApp = Nothing
Application.ScreenUpdating = True
End Sub

Open in new window

Avatar of newparadigmz

ASKER

Amazing! So much cleaner and "working" than what I was finding online (the word editor being the secret sauce here!).

Quick question. Instead of referring the picture by name, can I refer to the picture by the range (cell) that I know it sits in?

I'm running down a list of emails, each with a unique picture in the cell next to it.
Thanks for the feedback.

Well that's a tricky part.
Here is a workaround. The following code finds the picture in the cell next to the email cell considering the left and top positions are aligned with the left and top of the cell itself. The code assumes that the emails are listed in column A and the pictures are placed in column B. Change it as per your requirement. See if this approach works for you.
Dim shp As Shape

Sub CopyPictureToOutlook()
Dim ws As Worksheet
Dim EmailRng As Range, Cell As Range
Dim lr As Long
Dim olApp As Object
Dim olMail As Object
Dim olInsp As Object
Dim wdApp As Object
Dim Doc As Object
Dim DocSel As Object
Application.ScreenUpdating = False

Set ws = ActiveSheet                        'Sheet which contains the picture
lr = ws.Cells(Rows.Count, 1).End(xlUp).Row  'Assuming emails are in col. A then finding the last row in col. A with an email
Set EmailRng = ws.Range("A2:A" & lr)        'Email range in col. A

Set olApp = CreateObject("Outlook.Application")

For Each Cell In EmailRng
    Call GetPicture(Cell.Offset(0, 1))          'Getting Picture name by its position in the cell next to the email cell
    If Not shp Is Nothing Then
        shp.Copy
        
        Set olMail = olApp.CreateItem(0)
        With olMail
            .To = "Email ID here"       'Recipient's email address
            .Subject = "Subject here"   'Subject line
            .display                    'Displays the email
            '.send                      'Uncomment to send the email
        End With
        
        Set olInsp = olMail.GetInspector
        Set Doc = olInsp.WordEditor
        Set wdApp = Doc.Application
        Set DocSel = wdApp.Selection
        DocSel.Paste
    End If
    Set shp = Nothing
Next Cell
Set DocSel = Nothing
Set Doc = Nothing
Set wdApp = Nothing
Set olInsp = Nothing
Set olMail = Nothing
Set olApp = Nothing
Application.ScreenUpdating = True
End Sub

Sub GetPicture(rng As Range)
Dim i As Long
For i = 1 To ActiveSheet.Shapes.Count
    If ActiveSheet.Shapes(i).Left = rng.Left And ActiveSheet.Shapes(i).Top = rng.Top Then
        Set shp = ActiveSheet.Shapes(i)
        Exit For
    End If
Next i
End Sub

Open in new window

This totally works!

One last question please, How can I put text in the email above the picture?

So just text first, then picture below.

If I put it in olMail, pasting the picture, puts the picture before the text. I need to say something like, here is the picture below.
ASKER CERTIFIED SOLUTION
Avatar of Subodh Tiwari (Neeraj)
Subodh Tiwari (Neeraj)
Flag of India image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thank you so much!!!
You're welcome. Glad I could help.