Копировать файлы из папок и подпапок, используя vba

Question

Мне нужно скопировать файлы из папок и подпапок, но приведенный ниже код выполняет поиск только подпапок внутри основной папки.Но есть также некоторые подпапки внутри подпапок, например, C: \ abc \ bca - для этого abc является основной папкой, а bca - подпапкой, код работает для этого.Для c: \ abc \ bca \ cab или c: \ abc \ zxc \ cvg он не работает в папках в подпапках. Пожалуйста, помогите мне.Заранее спасибо

Sub copy_files_from_subfolders()

Dim fso As Object
Dim fld As Object
Dim fsofile As Object
Dim fsofol As Object
Dim filename As String
Dim snumber As Double
snumber = InputBox("Enter the Number", "Message from D")
filename = "_PTA.pdf"
sourcepath = "\\chec.local\"
destinationpath = "R:\Desa"

If Right(sourcepath, 1) <> "\" Then
sourcepath = sourcepath & "\"
End If

Set fso = CreateObject("scripting.filesystemobject")
Set fld = fso.GetFolder(sourcepath)
If fso.FolderExists(fld) Then
    For Each fsofol In fso.GetFolder(sourcepath).SubFolders
        For Each fsofile In fsofol.Files
            If InStr(1, fsofile.Name, snumber) = 1 Then
            MsgBox "Documents Copied"
            fsofile.Copy destinationpath
            End If
        Next
    Next
End If
End Sub