Import images VBA working but need help to customise

[Cyrill]

Hi - I'm new to the forum and to VBA so apologies for any mistake in terminology, please bear with. Firstly, thank you for your help in advance.

I took some existing VBA code to import images (.jpg) from a folder based on the text in col A matching the file name in the folder and storing the image in ColB. It works but there are three changes I would really like to make but don't know how.

Full code here:

Sub Kok()
Dim i%, ppath$
For i = 1 To 2      ' two rows just for demonstration
    ' file name at column A
    ppath = "C:\Users\Documents\Test images\" & CStr(Cells(i, 1).Value)
    With ActiveSheet.Pictures.Insert(ppath)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = 75
            .Height = 90
        End With
        .Left = ActiveSheet.Cells(i, 2).Left
        .Top = ActiveSheet.Cells(i, 2).Top
        .Placement = 1
        .PrintObject = True
    End With
Next
End Sub

1) At the moment I need to specify the number of rows but the sheet will change quite often and I would like it apply the formula for any row that is not empty in col A. It returns an error currently if the range is longer than the data.

For i = 1 To 2      ' two rows just for demonstration

2) Currently I need to add '.jpg' to the data in Col A of the sheet. Is there a way I can avoid having to do this?

3) As I mentioned, the sheet will change quite often. If I run the code again it imports all images, even if there was an image before. Is there a way to change the code so if there is an image already, it does not import it again? This is not as important as points 1 and 2 as I can just select one image then Ctrl+A and delete them all quickly but if it is possible and not time consuming it would be great.

I hope the above is clear and thank you for your help.

Cyrill

 

[NdNoviceHlp]

Hi Cyrill and Welcome to the Board! This seems like it should work for you. HTH. Dave

Sub Kok()
Dim i%, ppath$, Lastrow As Integer
Dim shp As Excel.shape
'delete all pictures
For Each shp In ActiveSheet.Shapes
If InStr(shp.Name, "Picture") Then
shp.Delete
End If
Next shp
'include all "A" rows
Lastrow = ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
For i = 1 To Lastrow
'ignore blank cells in "A"
If ActiveSheet.Cells(i, 1).Value <> vbNullString Then
    ' file name at column A
    'add .jpg file extension to "A"
    ppath = "C:\testfolder\" & CStr(Cells(i, 1).Value) & ".jpg"
    With ActiveSheet.Pictures.Insert(ppath)
        With .ShapeRange
            .LockAspectRatio = msoTrue
            .Width = 75
            .Height = 90
        End With
        .Left = ActiveSheet.Cells(i, 2).Left
        .Top = ActiveSheet.Cells(i, 2).Top
        .Placement = 1
        .PrintObject = True
    End With
End If
Next i
End Sub

 

[NdNoviceHlp]

Whoops. Your path should be...

ppath = "C:\Users\Documents\Test images\" & CStr(Cells(i, 1).Value) & ".jpg"

I mistakenly left my trial path. Dave

 

[Cyrill]

Thank you Dave, I tested it and it worked perfectly. I will look at what you did in more detail when I have time so I can learn from it.

These forums always remind me how nice people can be to each other. Thanks again.

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave