Option Explicit

Sub RecursiveFileSearch()
    Dim sourceFolder As String
    Dim destFolder As String
    Dim ws As Worksheet
    Dim nextRow As Long
    Dim fileName As String
    
    ' Set the source folder path
    sourceFolder = InputBox("Enter the source folder path:")
    
    ' Set the destination folder path
    destFolder = BrowseForFolder("Select the destination folder:")
    
    ' Check if the source folder path is provided
    If sourceFolder = "" Then Exit Sub
    
    ' Check if the destination folder path is provided
    If destFolder = "" Then Exit Sub
    
    ' Set the worksheet object
    Set ws = ThisWorkbook.Sheets("Sheet1") ' Replace "Sheet1" with your actual sheet name
    
    ' Find the next available row in the worksheet
    nextRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row + 1
    
    ' Call the recursive search function
    RecursiveSearch sourceFolder, ws, nextRow, destFolder
    
    MsgBox "File search complete!", vbInformation
End Sub

Sub RecursiveSearch(ByVal folder As String, ByVal ws As Worksheet, ByRef nextRow As Long, ByVal destFolder As String)
    Dim fileSystem As Object
    Dim file As Object
    Dim subFolder As Object
    Dim fileName As String
    Dim filePath As String
    Dim fileExtension As String
    Dim found As Boolean
    
    ' Create the file system object
    Set fileSystem = CreateObject("Scripting.FileSystemObject")
    
    ' Loop through each file in the folder
    For Each file In fileSystem.GetFolder(folder).Files
        ' Get the file name and extension
        fileName = fileSystem.GetBaseName(file.Name)
        fileExtension = LCase(fileSystem.GetExtensionName(file.Path))
        
        ' Search for file name in column A and update status in column B
        found = False
        With ws.Range("A:A")
            Set file = .Find(fileName, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
            If Not file Is Nothing Then
                found = True
                
                ' Update status as available
                ws.Cells(file.Row, 2).value = "Available"
                
                ' Copy the file to destination folder if it matches the allowed file types
                If fileExtension = "docx" Or fileExtension = "rtf" Or fileExtension = "pdf" Or fileExtension = "xlsx" Then
                    file.Copy destFolder & "\" & fileName & "." & fileExtension
                End If
            End If
        End With
        
        ' If file name not found, update status as not available
        If Not found Then
            nextRow = nextRow + 1
            ws.Cells(nextRow, 1).value = fileName
            ws.Cells(nextRow, 2).value = "Not Available"
        End If
    Next file
    
    ' Recursively search sub-folders
    For Each subFolder In fileSystem.GetFolder(folder).SubFolders
        RecursiveSearch subFolder.Path, ws, nextRow, destFolder
    Next subFolder
End Sub


Function BrowseForFolder(ByVal prompt As String) As String
    Dim objShell As Object, objFolder As Object
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(0, prompt, 0)
    
    If Not objFolder Is Nothing Then
        BrowseForFolder = objFolder.self.Path & "\"
    Else
        BrowseForFolder = ""
    End If
    
    Set objFolder = Nothing
    Set objShell = Nothing
End Function