Macro to search for pictures in subfolders [duplicate] - vba

Question

This question already has answers here:
Cycle through sub-folders and files in a user-specified root directory [duplicate]
(3 answers)
Closed 7 years ago.
I will realy appreciate your help on this issue. I'm quite new with macro.
The macro that I'm using is inserting a picture in Excel column A cells by taking the file name reference from the column B cells.
I have the following macro that works just fine if I know the subfolder were to search for the picture that I need but I don't know how to do it to search in all subfolders of Z:\mfs\PictureLibrary.
Here is the macro :
Sub Picture()
Dim picname As String
Dim pasteAt As Integer
Dim lThisRow As Long
lThisRow = 2
Do While (Cells(lThisRow, 2) <> "")
pasteAt = lThisRow
Cells(pasteAt, 1).Select 'This is where picture will be inserted
picname = Cells(lThisRow, 2) 'This is the picture name
present = Dir("Z:\mfs\PictureLibrary\Codello A14 Transfer\" & picname & ".jpg")
If present <> "" Then
ActiveSheet.Pictures.Insert("Z:\mfs\PictureLibrary\Codello A14 Transfer\" & picname & ".jpg").Select 'Path to where pictures are stored
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
' This resizes the picture
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
With Selection
'.Left = Range("A2").Left
'.Top = Range("A2").Top
.Left = Cells(pasteAt, 1).Left
.Top = Cells(pasteAt, 1).Top
.ShapeRange.LockAspectRatio = msoFalse
.ShapeRange.Height = 55#
.ShapeRange.Width = 40#
.ShapeRange.Rotation = 0#
End With
Else
Cells(pasteAt, 1) = ""
End If
lThisRow = lThisRow + 1
Loop
Range("A10").Select
Application.ScreenUpdating = True
Exit Sub
ErrNoPhoto:
MsgBox "Unable to Find Photo" 'Shows message box if picture not found
Exit Sub
Range("B20").Select
End Sub

Answer 1

Please, check the example below, it iterates through subfolders and search for your file, you just have to fit it in your code:
Dim FileSystem As Object
Const mainFolder As String = "Z:\mfs\PictureLibrary\Codello A14 Transfer\"
Sub YourProblem()
Dim filePath As String
filePath = Find("pictureName.jpg")
MsgBox filePath
End Sub
Function Find(picName As String) As String
Set FileSystem = CreateObject("Scripting.FileSystemObject")
Find = FindPicture(FileSystem.GetFolder(mainFolder), picName)
End Function
Function FindPicture(innerFolder, picName As String) As String
Dim pictureFound As String
pictureFound = Dir(innerFolder & "\" & picName)
If Len(Trim(pictureFound)) > 0 Then
FindPicture = innerFolder & "\" & pictureFound
Exit Function
Else
Dim subFolder
For Each subFolder In innerFolder.SubFolders
pictureFound = FindPicture(subFolder, picName)
If Len(Trim(pictureFound)) > 0 Then
FindPicture = pictureFound
Exit Function
End If
Next
End If
End Function