VBA fetch picture from a folder based on a string name. Contains wildcard

Question

I have an excel file with 160 rows and 2 columns of data - article name, price. I also have a folder which contains photos for those articles.

The problem is that that picture names are not EXACTLY the same as the article names in my excel sheet.

For example in my sheet I have article name: "3714-012-P140" but in the folder it would be "3714-012-P140---****".

However, after the initial 3 blocks of code (3714; 012; P140 in the example) there will always show up only 1 picture in the search.

How would one go about selecting the picture with a wildcard in it?

Additionally, how would I go about locking the picture into a specific cell in excel? What I mean to say is that when I resize or delete some rows/columns, the pictures move along the cells they are assigned to.

Dim ws As Worksheet
Dim articleCode As String, _
    findStr     As String
Set ws = Workbooks(1).Worksheets(1)

For i = 1 to ws.UsedRange.Rows.Count
    articleCode = ws.Cells(i,1)
    findStr = 'some code
    ActiveSheet.Pictures.Insert( _
        "C:\...path...\" & findStr & ".jpg").Select
Next i

Edit: I need to insert the photo into a third column in each row of data.

score 1 · Answer 1 · edited May 23 '17 at 12:06

Regarding "locking" a picture into a specific cell.

See here for info about how to link a shape to a cell.

Essentially you need to:

Position the picture over a cell. This can be done by setting the pictures (ie shape) .Top and .Left properties to be the same the cell you are linking the picture to.
Set the formula of the shape to equal the cell reference (this will also resize the shape to be the same size as the cell, and cause it to resize if the cell size is changed). See here

The code below taken from here will help you find a file in a folder that matches a "findstring". (It will need to be adapted!)

Sub FindPatternMatchedFiles()

    Dim objFSO As Object
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    Dim objRegExp As Object
    Set objRegExp = CreateObject("VBScript.RegExp")
    objRegExp.pattern = ".*xlsx"
    objRegExp.IgnoreCase = True

    Dim colFiles As Collection
    Set colFiles = New Collection

    RecursiveFileSearch "C:\Path\To\Your\Directory", objRegExp, colFiles, objFSO

    For Each f In colFiles
        Debug.Print (f)
        'Insert code here to do something with the matched files
    Next

    'Garbage Collection
    Set objFSO = Nothing
    Set objRegExp = Nothing

End Sub

I have solved the problem on my own already, but your answer should work as it is very similar to mine. I will post my answer below too. Thanks for the help =). — emihir0, Aug 05 '15 at 12:43

score 0 · Answer 2 · answered Aug 05 '15 at 12:46

Have your existing code call a function that accepts the name of the article (articleCode) and returns the path of the image file:

strImage = FindImage(articleCode)
If Len(strImage) > 0 Then ActiveSheet.Pictures.Insert strImage

Then you can write your function like so:

Function FindImage(strArticle As String) As String

    Dim objFile As Object
    With CreateObject("Scripting.FileSystemObject")
        For Each objFile In .GetFolder("c:\path\to\images").Files
            If StrComp(Left$(objFile.Name, Len(strArticle)), strArticle, vbTextCompare) = 0 Then

                ' Found an image file that begins with the article code.
                FindImage = objFile.Path
                Exit Function

            End If
        Next
    End With

End Function

score 0 · Accepted Answer · answered Aug 05 '15 at 12:48

The function below takes articleCode which is the name of the picture, row and column into which the picture should be input.

Function picInsert(articleCode As String, row As Integer, column As Integer)
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer
Dim ws As Worksheet
Set ws = Workbooks(1).Worksheets(2) 'your worksheet where the pictures will be put

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFolder = objFSO.GetFolder("...path...")

i = 1
For Each objFile In objFolder.Files
    If objFile.name Like (articleCode & "*") Then 'finds a picture with similar name to the one searched
        With ActiveSheet.Pictures.Insert(objFile.Path)
            With .ShapeRange
                .LockAspectRatio = msoTrue
                .Width = 5
                .Height = 15
            End With
            .Left = ActiveSheet.Cells(row, column).Left
            .Top = ActiveSheet.Cells(row, column).Top
            .Placement = 1 'locks the picture to a cell
        End With
    End If
    i = i + 1
Next objFile
End Function

This is a test sub with which I tried the function above. Basically a simple loop which goes over the rows, takes the articleCode from first column and inputs a picture into third column using the function above.

Public Sub test()
Dim ws As Worksheet
Dim i As Integer
Dim articleCode As String
Set ws = Workbooks(1).Worksheets(2)

For i = 1 To ws.UsedRange.Rows.Count
    articleCode = ws.Cells(i, 1)
    Call picInsert(articleCode, i, 3)
Next i
End Sub

VBA fetch picture from a folder based on a string name. Contains wildcard

3 Answers3