Email image from lookup

[bouncey]

Hi

I have posted this before but had no joy, so I am reposting hoping to resolve.

I have the following code that looks up an image based on the text in the cells in column A, this look-up the image and places it in column L. The problem is when I email the file the images disappear. Is there any way to ensure that the images are kept in the sheet?
Code:
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myPict As Picture
Dim PictureLoc As String
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row

ActiveSheet.Pictures.Delete
For r = 2 To lr
PictureLoc = "C\photography" & Range("A" & r).Value & ".jpg"

With Range("l" & r)
Set myPict = ActiveSheet.Pictures.AddPicture(PictureLoc)
.RowHeight = 144
myPict.Top = .Top
myPict.Left = .Left
myPict.Width = 110
myPict.Height = 140


myPict.Placement = xlMoveAndSize
End With

Next r
End Sub
Thanks in advance.

 

[Domenic]

Try using the AddPicture method of the Shapes object instead. By the way, I noticed that you're missing a colon in your assigned path. Also, I'm guessing that "photography" is the name of your folder, not part of the filename. If so, you're also missing a backslash (\). So maybe something like this...

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim myPict As Shape
    Dim PictureLoc As String
    Dim lr As Long, r As Long
    
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
    ActiveSheet.Pictures.Delete
    
    For r = 2 To lr
        PictureLoc = "C:\photography\" & Range("A" & r).Value & ".jpg"
        With Range("l" & r)
            .RowHeight = 144
            Set myPict = ActiveSheet.Shapes.AddPicture(Filename:=PictureLoc, _
                LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=.Left, Top:=.Top, Width:=110, Height:=140)
            myPict.Placement = xlMoveAndSize
        End With
    Next r
    
End Sub

Hope this helps!

 

[bouncey]

Thank you for your response.

I get the 1004 error message file not found! The jpeg file is there and named the same with caps. The debug highlights "Set myPict = ActiveSheet.Shapes.AddPicture(Filename:=PictureLoc, _ LinkToFile:=msoFalse, SaveWithDocument:=msoTrue, Left:=.Left, Top:=.Top, Width:=110, Height:=140)"

I have no idea how to fix this.

 

[Domenic]

Maybe the path is incorrect? If you run it again, when you get that same error, move your cursor over the variable PictureLoc. Is it a valid path and filename that is displayed? What string has been assigned to it?