Copy file PDF/DWG/DXF from local server to a PC specific folder

SEARCH AND COPY.xlsm

Hi all

I've an Excel file with VBA macro inside...I use this file to search and copy specific files into a local nas server.

The problem is that the macro is configured to search in a specific location on the server nas

"\\nas01\Archivio Disegni\DV1\"

But I want the macro to search both in "Archivio Disegni" and also in its sub folders... As you can see on the atthached file, the sSourcePath is

sSourcePath = "\\nas01\Archivio Disegni\DV1\"

, so it is set to search in the specific DV! folder in Archivio Disegni,...and I "simply" want the macro to search in both in "Archivio Disegni" and also in its sub folders...all the file i'll serach has unique name, such as DV0001 and so on...every file I search has a unique name, so it's impossible to have duplicate file errors etc

The excel file is then set to return "not exist" if the file does not exist on the server, or PDF copied if it exists, etc as you can see in the attached file. but this is already working

This is the macro I have

Sub CopyDWG()
    Dim iRow As Integer         ' ROW COUNTER.
    Dim sSourcePath As String
    Dim sDestinationPath As String
    Dim sFileType As String
   
    Dim bContinue As Boolean
   
    bContinue = True
    iRow = 5
   
    ' THE SOURCE AND DESTINATION FOLDER WITH PATH.
    sSourcePath = "\\nas01\Archivio Disegni\DV1\"
    sDestinationPath = "C:\Users\luca\Desktop\DRW\"
   
    sFileType = ".dwg"      ' TRY WITH OTHER FILE TYPES LIKE ".pdf".
 
    ' LOOP THROUGH COLUMN "D" 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.
           
            If Len(Dir(sSourcePath & Range("A" & CStr(iRow)).Value & sFileType)) = 0 Then
                Range("D" & CStr(iRow)).Value = "Does Not Exists"
                Range("D" & CStr(iRow)).Font.Bold = True
            Else
                Range("D" & CStr(iRow)).Value = "DWG Copied"
                Range("D" & CStr(iRow)).Font.Bold = False
           
                If Trim(sDestinationPath) <> "" Then
                    Dim objFSO
                    Set objFSO = CreateObject("scripting.filesystemobject")
                   
                    ' CHECK IF DESTINATION FOLDER EXISTS.
                    If objFSO.FolderExists(sDestinationPath) = False Then
                        MsgBox sDestinationPath & " Does Not Exists"
                        Exit Sub
                    End If
                   
                    ' METHOD 1) - USING "CopyFile" METHOD TO COPY THE FILES.
                    objFSO.CopyFile Source:=sSourcePath & Range("A" & CStr(iRow)).Value & _
                        sFileType, Destination:=sDestinationPath
                   
                  End If
            End If
        End If
     
       iRow = iRow + 1      ' INCREMENT ROW COUNTER.
    Wend
End Sub

Can someone help me with this, I cannot find any solution since i'm not that good with VBA.

Thanks all
Best Regards
Luca