Using Wildcard for Folder Copy

[huskersippi]

I am able to copy all files from one subfolder but need to loop through directory and copy files from all subfolders with the same name.

Currently my folder structure is as such: C:\Users\Me\Desktop\TestLoop\Test-277\O&M\CopyFinal

So in this instance I would copy all .doc files from the CopyFinal subfolder. The issue is different names among the folder tree. The folder "Test-277" would be the name to change in the directory.

For example:

C:\Users\Me\Desktop\TestLoop\Test-277\O&M\CopyFinal
C:\Users\Me\Desktop\TestLoop\Test-278\O&M\CopyFinal
C:\Users\Me\Desktop\TestLoop\Test-279\O&M\CopyFinal

How can I use a wildcard value "Test-*" to allow my script to loop through entire directory and if there is a folder named CopyFinal, copy all files?

Here is my attempt so far:

Sub Copy_Folder()'This example copy all files and subfolders from FromPath to ToPath.
'Note: If ToPath already exist it will overwrite existing files in this folder
'if ToPath not exist it will be made for you.
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String


    FromPath = "C:\Users\Me\Desktop\TestLoop\Test-277\O&M\CopyFinal"  '<< Change
    ToPath = "C:\Users\Me\Desktop\Destination"    '<< Change


    'If you want to create a backup of your folder every time you run this macro
    'you can create a unique folder with a Date/Time stamp.
    'ToPath = "C:\Users\Me\Desktop\Destination" & Format(Now, "yyyy-mm-dd h-mm-ss")


    If Right(FromPath, 1) = "\" Then
        FromPath = Left(FromPath, Len(FromPath) - 1)
    End If


    If Right(ToPath, 1) = "\" Then
        ToPath = Left(ToPath, Len(ToPath) - 1)
    End If


    Set FSO = CreateObject("scripting.filesystemobject")


    If FSO.FolderExists(FromPath) = False Then
        MsgBox FromPath & " doesn't exist"
        Exit Sub
    End If


    FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath


End Sub

 

[crazydragon84]

you need to first loop through every folder in "C:\Users\Me\Desktop\TestLoop" directory (instead of dictating Test - *). let's say you declare that as "FromPath", then you can say for each file in the FromPath & "\O&M\CopyFinal" copy to the ToPath. But based on the code you have above, i'm not sure if you are just moving entire folder into the ToPath or just the .doc files in the folder?

 

[huskersippi]

Correct in the files im moving. It is the entire folder. I referenced .doc because those are the only files in these folders. How would I write that snipet "for each file in the FromPath & "\O&M\CopyFinal" copy to the ToPath"and where would I place it?

 

[huskersippi]

Crazydragon84 Thank you for your help! I've solved. Below is the solution.

Sub cpy2Folders()
sourceF = "C:\SourceFolder\" 
destinationF = "C:\DestinationFolder\" 
Set FSO = CreateObject("Scripting.FileSystemObject") 
Set ofolder = FSO.GetFolder(sourceF) 
For Each subF In ofolder.subfolders 
    For Each sf In subF.subfolders 
        If InStr(UCase(sf), "TEST") > 0 Then 
            For Each testF In sf.subfolders 
                If InStr(UCase(testF), "FolderNameToSearchFor") > 0 Then
                    For Each shapeF In testF.Files 
                        FSO.copyfile shapeF, destinationF 
                    Next
                End If
            Next
        End If
    Next
Next
End Sub

 

[crazydragon84]

cool! congrats!