Copy files from one folder hierarchy to an other

svjensen

Board Regular
Joined
Jun 10, 2009
Messages
118
I need to copy all files from one folder hierarchy to an other.

An example:
My source is in 'c:\1' which has a number of subfolders, some of which have subfolders, etc. Along the lines of:
c:\1
c:\1\a
c:\1\b
c:\1\b\1
c:\1\c
c:\1\c\1
...

All files have to be copied to 'c:\2' and go to the same folder as they come from. If the folder does not exist it should be created.

Is there an easy way to do this, or do I have to loop through all folders and subfolders, and do them one at a time?

/Soren
 

Excel Facts

Which Excel functions can ignore hidden rows?
The SUBTOTAL and AGGREGATE functions ignore hidden rows. AGGREGATE can also exclude error cells and more.

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092
In Windows Explorer right click the 1 folder and choose Copy. Then right click the C disk and choose Paste. Then rename Copy of 1 as 2.
 

svjensen

Board Regular
Joined
Jun 10, 2009
Messages
118
I guess that I was not clear enough in my description ;)

1. I need to do this in VBA
2. The destination hierarchy already exists (although there might some differences between them) - so folders must be created if not already in destination hierarchy
3. Existing files in the destination hierarchy must be left "unharmed"

/Soren
 

svjensen

Board Regular
Joined
Jun 10, 2009
Messages
118
The following did the trick (I got this off the Internet somewhere, but forgot the URL).

Code:
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\Ron\Data"  '<< Change
    ToPath = "C:\Users\Ron\Test"    '<< 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\Ron\" & 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
 

foolios

New Member
Joined
Aug 4, 2011
Messages
21
The following did the trick (I got this off the Internet somewhere, but forgot the URL).

Code:
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\Ron\Data"  '<< Change
    ToPath = "C:\Users\Ron\Test"    '<< 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\Ron\" & 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

At the lines:
Code:
    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
Can someone please explain how that part of the code works? Is it checking to see if a backward slash is before or after a folder name in the directory?

Thanks
 

Andrew Poulsom

MrExcel MVP
Joined
Jul 21, 2002
Messages
73,092

ADVERTISEMENT

It's removing the trailing backslash if there is one.
 

foolios

New Member
Joined
Aug 4, 2011
Messages
21
Thank you for replying.
Why does this need to be checked?

Shouldn't the code simply have:
C:\Users\Ron

instead of:
C:\Users\Ron\

and then no need for a check? What am I missing here? Thanks!
 

brettdj

Active Member
Joined
Feb 5, 2003
Messages
426
Shelling xcopy is an efficient way to do this, especially given the versatility of the command switches

Something like this to copy non empty folders under C:\1 to C:\2

Cheers

Dave

Code:
Sub FolderSync2()
    Dim objWS
    Dim Path1 As String, Path2 As String
    Path1 = "C:\1\*.*"
    Path2 = "C:\2"
    Call XcopyFiles(Path1, Path2)
End Sub
Sub XcopyFiles(strSource, strDestination)
    Set wsh = CreateObject("wscript.shell")
    wsh.Run "xcopy.exe """ & strSource & """ """ & strDestination & """ /d /s /y /h /r", 1, True
    Set wsh = Nothing
End Sub
 

foolios

New Member
Joined
Aug 4, 2011
Messages
21
I'm not sure if that was a reply to my question or a previous post.
Could you elaborate a little more? I don't understand...

Thanks in advance!
 
Master Excel Bundle

Excel contains over 450 functions, with more added every year. That’s a huge number, so where should you start? Right here with this bundle.

Forum statistics

Threads
1,152,257
Messages
5,769,075
Members
425,515
Latest member
baltusf

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top