how can i walk on folders and sub-folders and get files with specific file type then copy to another directory in VBA?

Question

I want to copy specific file type(*.SLDDRW) from source to destination,in destination path we have lots of folders and sub-folders .in below code i am trying to walk on any sub folders but unfortunately it didn't work and didn't walk all sub-folders S.O can help me?

Sub copy_specific_files_in_folder()
Dim FSO As Object
Dim sourcePath As String
Dim destinationPath As String 
Dim fileExtn As String

sourcePath = "C:\Users\6\"
destinationPath = "C:\Users\"

fileExtn = "*.SLDDRW"

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

Set FSO = CreateObject ("scripting.filesystemobject")
If FSO.FolderExists(sourcepath) = False  Then 
MsgBox sourcePath & " does not exist"

Exit Sub
End If

  FSO.CopyFile Source:=sourcePath & fileExtn, Destination :=destinationPath
  copy_files_from_subfolders
 MsgBox "Your files have been copied from the sub-folders of " & sourcePath
 End sub




 sub copy_files_from_subfolders()
 Dim FSO AS Object , fld As Object
 Dim fsoFile As Object
 Dim fsoFol As Object

 sourcePath = "C:\Users\6\"
 targetPath = "C:\Users\"

If Right (sourcePath , 1) <> "\"  then sourcePath = sourcePath & "\"
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 Right (fsoFile, 6)  = "sldprt" Then 
            fsoFile.Copy targetPath
            End If
         Next
      Next
 End If

See [this answer](https://stackoverflow.com/a/22645439/4088852). — Comintern, Jan 29 '19 at 14:36
Possible duplicate of [Cycle through sub-folders and files in a user-specified root directory](https://stackoverflow.com/questions/14245712/cycle-through-sub-folders-and-files-in-a-user-specified-root-directory) — Luuklag, Jan 29 '19 at 14:36
Then see [this answer](https://stackoverflow.com/q/26147520/4088852). — Comintern, Jan 29 '19 at 15:12
I have.. I'm not sure how to integrate that with what I already have — Farzaneh Kamarei, Jan 29 '19 at 15:24

tigeravatar · Answer 1 · 2019-01-29T16:25:41.910

0

Here's a function that will recursively search a folder and all subfolders for a specific extension and then copy found files to a specified destination:

Sub SearchFoldersAndCopy(ByVal arg_sFolderPath As String, _
                         ByVal arg_sDestinationFolder As String, _
                         ByVal arg_sExtension As String)

    Dim oFSO As Object
    Dim oFolder As Object
    Dim oSubFolder As Object
    Dim sTest As String

    'Test if FolderPath exists
    sTest = Dir(arg_sFolderPath, vbDirectory)
    If Len(sTest) = 0 Then
        MsgBox "Specified folder [" & arg_sFolderPath & "] doesn't exist.  Please check spelling or create the directory."
        Exit Sub
    End If

    'Test if Destination exists
    sTest = Dir(arg_sDestinationFolder, vbDirectory)
    If Len(sTest) = 0 Then
        MsgBox "Specified destination [" & arg_sDestinationFolder & "] doesn't exist.  Please check spelling or create the directory."
        Exit Sub
    End If

    'FolderPath and Destination both exist, proceed with search and copy
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFolder = oFSO.GetFolder(arg_sFolderPath)

    'Test if any files with the Extension exist in directory and copy if one or more found
    sTest = Dir(oFolder.Path & Application.PathSeparator & "*." & arg_sExtension)
    If Len(sTest) > 0 Then oFSO.copyfile oFolder.Path & Application.PathSeparator & "*." & arg_sExtension, arg_sDestinationFolder

    'Recursively search subfolders
    For Each oSubFolder In oFolder.SubFolders
        SearchFoldersAndCopy oSubFolder.Path, arg_sDestinationFolder, arg_sExtension
    Next oSubFolder

End Sub

Here's an example of how to call it:

Sub tgr()

    Dim sStartFolder As String
    Dim sDestination As String
    Dim sExtension As String

    sStartFolder = "C:\Test"
    sDestination = "C:\Output\"    '<-- The ending \ may be required on some systems
    sExtension = "SLDDRW"

    SearchFoldersAndCopy sStartFolder, sDestination, sExtension

End Sub

edited Jan 29 '19 at 16:25

answered Jan 29 '19 at 15:41

tigeravatar

26,199
5
30
38

thank you for your answer why i have pemission denied in this line [If Len(sTest) > 0 Then oFSO.CopyFile oFolder.path & Application.PathSeparator & "*." & arg_sExtension, arg_sDestinationFolder – Farzaneh Kamarei Jan 29 '19 at 16:04
@FarzanehKamarei Permission Denied means you don't have write access to the Destination folder you are trying to copy to. Is the Destination folder a network folder or something? – tigeravatar Jan 29 '19 at 16:06
this is network folder but i check it i can copy files and have permission – Farzaneh Kamarei Jan 29 '19 at 16:08
@FarzanehKamarei If you change your destination folder to a local folder (like `C:\Output`), then does the code run ok for you? – tigeravatar Jan 29 '19 at 16:13
@FarzanehKamarei It's also possible that the file you're trying to copy is locked by an application and can't be interacted with until the application gets closed. – tigeravatar Jan 29 '19 at 16:19
@FarzanehKamarei Another possibility is that the Destination needs an ending "\", I'll edit the answer to reflect. – tigeravatar Jan 29 '19 at 16:25
@tigeravator thank youuuuuuuuuuuuu . it has worked :) – Farzaneh Kamarei Feb 01 '19 at 06:33
but i have another question , if i need more file type for example pdf , xls and the destination folder is seprete , i have to write two tgr and two searchfoldersandcopy??? – Farzaneh Kamarei Feb 01 '19 at 07:30

how can i walk on folders and sub-folders and get files with specific file type then copy to another directory in VBA?

1 Answers1