Copy files from one folder hierarchy to an other

[svjensen]

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

 

[Andrew Poulsom]

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]

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]

The following did the trick (I got this off the Internet somewhere, but forgot the URL).

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

 

[Andrew Poulsom]

Here's the link:

http://www.rondebruin.nl/folder.htm

 

[foolios]

The following did the trick (I got this off the Internet somewhere, but forgot the URL).

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:

    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]

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

 

[foolios]

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]

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

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]

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!