VBA - copy folders to new directory, but 'skip' certain folders

[RobbieC]

Hi there, I have a bit of VBA code (from Ron de Bruin) which successfully copies folders in a directory to another:

Sub Copy_Folder()

    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String

    FromPath = "C:\MyFolder"
    ToPath = "C:\MyBackUpFolder"

    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

I can see that this line does the business:

FSO.CopyFolder Source:=FromPath, Destination:=ToPath

But I have 2 folders named 'NotToCopy' & 'NotToCopyEither' which I want to exclude from this procedure

Can anyone point me in the right direction for this? If you can, I'd be very grateful

Thanks

 

[Joe4]

Maybe try changing this:

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

to this:

If Mid(FromPath, InStrRev(FromPath, "\") + 1, 9) <> "NotToCopy" Then
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
End If

 

[Joe4]

That last code only works if "NotToCopy" is the last folder listed in the path.
Here is an updated version that will work if "NotToCopy" is found anywhere in the file path.

If InStr(FromPath, "NotToCopy") = 0 Then
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
End If

 

[RobbieC]

Thanks Joe, I just tried that and it didn't work... I added this line to check what it was doing:

msgbox Mid(FromPath, InStrRev(FromPath, "\") + 1, 9)

and it just returned the 'main folder' that it's checking the contents of ie. FromPath

It's not actually checking the folders in that directory before copying

Maybe I didn't explain properly... The 'FromPath' is the main directory where I have several sub-folders and so the above code copies all of those to the new directory 'Destination'

Two of those sub-folders are the 2 that I don't want to copy over 'NotToCopy' & 'NotToCopyEither'

I dunno if that helps?

 

[RobbieC]

I posted that before seeing your previous reply...

 

[Joe4]

Please see/try my second post.

If that does not work, please post the exact full path of the folders you do not want copied.

 

[RobbieC]

Hi Joe, I still cant get it to work unfortunately...

I'm using: FromPath = ThisWorkbook &"\PDFs"
and the folders I want to exclude are "StandingTime" & "RiskAssessment", both of which are sub-folders in the PDFs folder

 

[Joe4]

It seems that you have changed the names of the folders that you do not want to copy over.

First you said this:

Two of those sub-folders are the 2 that I don't want to copy over 'NotToCopy' & 'NotToCopyEither'

Now, you are saying this:

the folders I want to exclude are "StandingTime" & "RiskAssessment", both of which are sub-folders in the PDFs folder

Can you confirm the real names of the folders you wish to exclude?

 

[RobbieC]

"StandingTime" & "RiskAssessment" are the folder names

 

[Joe4]

"StandingTime" & "RiskAssessment" are the folder names

OK, I take it that you were oversimplifying it originally. I usually tell people not to do that, unless they feel comfortable enough taking the solution that is given to them and adjusting it to work for their actual scenarios. It is usually best to give the exact specifications of your issue, so the answer you get will work for you (hopefully "plug & play").

So, I think you would need the code to look like this:

If (InStr(FromPath, "StandingTime") = 0) And (InStr(FromPath, "RiskAssessment") = 0) Then
    FSO.CopyFolder Source:=FromPath, Destination:=ToPath
    MsgBox "You can find the files and subfolders from " & FromPath & " in " & ToPath
End If