Option Explicit

Sub CopyFiles1()                                  ''Code

    Dim iRow   As Integer                         ' ROW COUNTER.
    Dim SourcePath As String
    Dim DestinationPath As String
    Dim sFileType   As Variant                    '<- changed
    Dim bContinue As Boolean
    Dim x      As Long                            '<- added

    bContinue = True
    iRow = 2
    ' THE SOURCE AND DESTINATION FOLDER WITH PATH.
    SourcePath = InputBox("PLEASE ENTER PATH", "SOURCE PATH") & "\"
    DestinationPath = InputBox("PLEASE ENTER PATH", "DESTINATION PATH") & "\"
    sFileType = Array(".rtf", ".docx", ".pdf")    '<- changed
    'sFileType = ".docx"
    'sFileType = ".rtf"
    ' LOOP THROUGH COLUMN "A" TO PICK THE FILES.
    While bContinue
        If Len(Range("A" & CStr(iRow)).Value) = 0 Then ' DO NOTHING IF THE COLUMN IS BLANK.
            MsgBox "Process executed"             ' DONE.
            bContinue = False
        Else
            ' CHECK IF FILES EXISTS.
            For x = LBound(sFileType) To UBound(sFileType) '<- added
                If Len(Dir(SourcePath & Range("A" & CStr(iRow)).Value & sFileType(x))) = 0 Then
                    Range("B" & CStr(iRow)).Value = "Does Not Exists"
                    Range("B" & CStr(iRow)).Font.Bold = True
                Else
                    Range("B" & CStr(iRow)).Value = "Copied"
                    Range("B" & CStr(iRow)).Font.Bold = False
                    If Trim(DestinationPath) <> "" Then
                        Dim objFSO
                        Set objFSO = CreateObject("scripting.filesystemobject")
                        ' CHECK IF DESTINATION FOLDER EXISTS.
                        If objFSO.FolderExists(DestinationPath) = False Then
                            MsgBox DestinationPath & " Does Not Exists"
                            Exit Sub
                        End If
                        '*****
                        ' HERE I HAVE INCLUDED TWO DIFFERENT METHODS.
                        ' I HAVE COMMENTED THE SECOND METHOD. TO THE SEE THE RESULT OF THE
                        ' SECOND METHOD, UNCOMMENT IT AND COMMENT THE FIRST METHOD.
                        ' METHOD 1) - USING "CopyFile" METHOD TO COPY THE FILES.
                        objFSO.CopyFile Source:=SourcePath & Range("A" & CStr(iRow)).Value & sFileType(x), Destination:=DestinationPath '<- changed
                        ' METHOD 2) - USING "MoveFile" METHOD TO PERMANENTLY MOVE THE FILES.
                        'objFSO.MoveFile Source:=sSourcePath & Range("B" & CStr(iRow)).Value & sFileType(x) , Destination:=sDestinationPath
                        '*****
                    End If
                End If
            Next x                                '<- added
        End If
        iRow = iRow + 1                           ' INCREMENT ROW COUNTER.
    Wend
    Set objFSO = Nothing
    
End Sub

Set FSO = CreateObject("scripting.filesystemobject")
'First loop through files
    For Each FileInFromFolder In FSO.GetFolder(strPath).Files
        Fdate = Int(FileInFromFolder.DateLastModified)
        'If Fdate >= Date - 1 Then
            FileInFromFolder.Copy strTarget
        'end if
    Next

    'Next loop throug folders
    For Each FolderInFromFolder In FSO.GetFolder(strPath).SubFolders
        'intSubFolderStartPos = InStr(1, FolderInFromFolder.Path, strPath)
        'If intSubFolderStartPos = 1 Then

        strFolderName = Right(FolderInFromFolder.Path, Len(FolderInFromFolder.Path) - Len(strPath))
        MkDir strTarget & "\" & strFolderName

        CopyFiles FolderInFromFolder.Path & "\", strTarget & "\" & strFolderName & "\"

    Next 'Folder

Sub CopyFilesBasedOnXcelValue()
    Dim srcFolder As String
    Dim destFolder As String
    Dim fileTypes As Variant
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    
    ' Input folder location
    srcFolder = InputBox("Enter the source folder location:")
    
    ' Destination folder location
    destFolder = InputBox("Enter the destination folder location:")
    
    ' File types to search for
    fileTypes = Array("*.pdf", "*.doc", "*.docx", "*.rtf", "*.xls", "*.xlsx")
    
    ' Set the worksheet to the active sheet
    Set ws = ActiveSheet
    
    With ws
        ' Get the last row in column A
        lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        ' Loop through each row in column A
        For i = 1 To lastRow
            ' Check if the file is available
            If FileExists(srcFolder & "\" & .Cells(i, "A").Value, fileTypes) Then
                ' Copy the file to the destination folder
                FileCopy srcFolder & "\" & .Cells(i, "A").Value, destFolder & "\" & .Cells(i, "A").Value
                ' Update the status in column B
                .Cells(i, "B").Value = "Available"
            Else
                ' Update the status in column B
                .Cells(i, "B").Value = "N/A"
            End If
        Next i
    End With
End Sub

Function FileExists(filePath As String, fileTypes As Variant) As Boolean
    Dim fileName As String
    Dim fileType As Variant
    Dim filesFound As Boolean
    Dim i As Long
    
    ' Check if the file exists with any of the specified file types
    For Each fileType In fileTypes
        fileName = Dir(filePath & fileType)
        If Len(fileName) > 0 Then
            filesFound = True
            Exit For
        End If
    Next fileType
    
    FileExists = filesFound
End Function

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