Search for files within a folder and it's subfolders

[vbavirgin]

Hi,

I have cobbled together the following code which works. The problem I have is that I need the file search to extend to the subfolders within the selected folder. Can anyone help?


Function picInsert(folder As String, articleCode As String, material As String, colour As String, row As Integer, column As Integer)
Dim objFSO As Object
Dim objFolder As Object
Dim objFile As Object
Dim i As Integer


Set objFSO = CreateObject("Scripting.FileSystemObject")


'Enter the folder where the images are stored
Set objFolder = objFSO.GetFolder(folder)


i = 1
For Each objFile In objFolder.Files
If objFile.Name Like (LCase(articleCode) & "*" & LCase(material) & "*" & LCase(colour) & "*") Or objFile.Name Like (UCase(articleCode) & "*" & UCase(material) & "*" & UCase(colour) & "*") Then
With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50)
.Fill.UserPicture objFile
.Left = ActiveSheet.Cells(row, column).Left
.Top = ActiveSheet.Cells(row, column).Top
.Height = ActiveSheet.Cells(row, column).Height
.Width = ActiveSheet.Cells(row, column).Width
End With
End If
i = i + 1
Next objFile
End Function

 

[bobsan42]

You will need too use recursion - the code must call itself to go one level deeper.

Sub picInsert(folder As String, articleCode As String, material As String, colour As String, row As Integer, column As Integer)
    Dim objFSO As Object
    Dim objFolder As Object, objSubfolder As Object
    Dim objFile As Object
    Dim i As Integer
    
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    
    'Enter the folder where the images are stored
    Set objFolder = objFSO.GetFolder(folder)
    
    
    i = 1
    For Each objFile In objFolder.Files
        If objFile.Name Like (LCase(articleCode) & "*" & LCase(material) & "*" & LCase(colour) & "*") Or objFile.Name Like (UCase(articleCode) & "*" & UCase(material) & "*" & UCase(colour) & "*") Then
            With ActiveSheet.Shapes.AddTextbox(msoTextOrientationHorizontal, 100, 100, 200, 50)
                .Fill.UserPicture objFile
                .Left = ActiveSheet.Cells(row, column).Left
                .Top = ActiveSheet.Cells(row, column).Top
                .Height = ActiveSheet.Cells(row, column).Height
                .Width = ActiveSheet.Cells(row, column).Width
            End With
        End If
        i = i + 1
    Next objFile
    
    If objFolder.Folders.Count > 0 Then
        For Each objSubfolder In objFolder.Folders
            Call picInsert(objSubfolder.Path, articleCode, material, colour, row, column)
        Next objSubfolder
    End If
    
    Set objFSO = Nothing
    Set objFolder = Nothing
    Set objSubfolder = Nothing
    Set objFile = Nothing
    
End Sub

I also made some small changes to your code to make it generally correct. And changed the Function to Sub.
Also it is not a good idea to use reserved words like row, column etc. COLOUR is safe to use because of the U. Use something like row1, ColumnNum ....

However - if you are planning to scan folders with large amounts of files this code will not be efficient. Inserting even a single picture will require scanning of all others preceding it. Much faster will be to use DIR and filter only the files you need.

 

[vbavirgin]

Thank you very much