I have listed of files name in column A, i know the parent(Source) folder, but i don’t know which sub-folder have my file. In main folder there is lot of sub folder, so search all sub folder if file name available that file copy and move to destination folder.

Code Explanation: First it ask source folder location destination, i choose parent folder(parent folder have lot of sub folder) and then destination folder then it recursively search folder which folder have exact file name if its available any folder it copy and move to destination folder. But this code gone wrong while running. Please anyone solve this issue.

Sub copy_and_move_selectedfiles_recursive()
    On Error Resume Next
    Dim sourceFolderDialog As FileDialog
    Dim destinationFolderDialog As FileDialog
    Dim sourceFolderPath As String
    Dim destinationFolderPath As String
    Dim FSO As Object
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim c As Range
    ' Select source folder
    Set sourceFolderDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With sourceFolderDialog
        .Title = "Select Source Folder"
        .AllowMultiSelect = False
        If .Show = -1 Then
            sourceFolderPath = .SelectedItems(1) & ""
        Else
            Exit Sub
        End If
    End With
    ' Select destination folder
    Set destinationFolderDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With destinationFolderDialog
        .Title = "Select Destination Folder"
        .AllowMultiSelect = False
        If .Show = -1 Then
            destinationFolderPath = .SelectedItems(1) & ""
        Else
            Exit Sub
        End If
    End With
    ' Initialize FileSystemObject
    Set FSO = CreateObject("Scripting.FileSystemObject")
    ' Set worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Change the sheet name as needed
    ' Find the last row with data in column C
    lastRow = ws.Cells(ws.Rows.Count, 3).End(xlUp).Row
    ' Loop through each cell in column C from C3 to the last row
    For Each c In ws.Range("C3:C" & lastRow)
        ' Search for the file in source folder and its subfolders
        If FileExistsRecursive(sourceFolderPath, c.Value) Then
            ' File exists in source folder or its subfolders
            c.Offset(0, 1).Value = "Moved"
            ' Move the file to destination folder
            FSO.MoveFile sourceFolderPath & c.Value, destinationFolderPath & c.Value
        Else
            ' File not found in source folder or its subfolders
            c.Offset(0, 1).Value = "Not Found"
        End If
    Next c
    ' Clean up
    Set FSO = Nothing
    ' Show completion message
    MsgBox "Process Completed"
End Sub
 
Function FileExistsRecursive(ByVal folderPath As String, ByVal fileName As String) As Boolean
    Dim FSO As Object
    Dim objFolder As Object
    Dim objFile As Object
    Dim found As Boolean
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = FSO.GetFolder(folderPath)
    ' Check if the file exists in the current folder
    For Each objFile In objFolder.Files
        If objFile.Name = fileName Then
            Set FSO = Nothing
            FileExistsRecursive = True
            Exit Function
        End If
    Next objFile
    ' Recursively search through subfolders
    For Each objFolder In objFolder.SubFolders
        If FileExistsRecursive(objFolder.Path, fileName) Then
            Set FSO = Nothing
            FileExistsRecursive = True
            Exit Function
        End If
    Next objFolder
    ' File not found
    Set FSO = Nothing
    FileExistsRecursive = False
End Function