Copying Folders from one location to another based on a excel spreadsheet

[Philip L]

Hi I was wondering if I can get some help, we have received a load of data in folders based on cases, we know from each case via a lookup which case belongs to which individual.

Existing Folder	New Folder
h:\ESCC\OB\KYB\3923	H:\ESCC\Donna Waddington 051970
h:\ESCC\OW\KYB\3854	H:\ESCC\Debra Cheesman 02061981
h:\ESCC\OW\KYB\4143	H:\ESCC\Colleen Jones 11091981
h:\ESCC\OB\NC1\3988	H:\ESCC\Sarah Jacobs Jones 041969
h:\ESCC\OM\CMH\3608	H:\ESCC\Hannah AL-Moosavi 051967

<colgroup><col><col></colgroup><tbody>
</tbody>

I need to copy the data from the existing folder to a new folder based on the file paths in the excel spreadsheet.

I can use the following script to move one file but this doesn't work for multiple folders..

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 SubCan I get some help?