Copy source folders to destination folders

[abenitez77]

I have my source folders that are named like this "12345", "00345", "28429" (folder name is 5 digit numbers). My destination folders are like this "00001X12345", "00002X00345", etc...

The last 5 spaces of the destination folder names match up with the source folder names. In some cases the folders don't exists in the destination folders and I have to just copy the entire folder to the path of the destination (or create the new folder and copy all the files in them to the new location). I can copy the existing folders but am having trouble finishing it to copy folders that don't exist in the destination folder path.
I need to create the new folder in the destination path and copy all the files from source folder to that new path.

This is the code I have so far:

Set objFSO = CreateObject("Scripting.FileSystemObject")

Set SRCobjFolder = objFSO.GetFolder("C:\Data\BCF\Images\")
Set SRCcolSubfolders = SRCobjFolder.Subfolders

Set DESTobjFolder = objFSO.GetFolder("C:\Data\ANP\Images\")
Set DESTcolSubfolders = DESTobjFolder.Subfolders

dim filesys
Dim Folder
Set filesys=CreateObject("Scripting.FileSystemObject")

For Each SRCobjSubfolder in SRCcolSubfolders
For Each DESTobjSubfolder In DESTcolsubfolders
' Check if folder exists in the destination path.
If DESTobjsubfolder.Name = Right(SRCobjsubfolder.Name,7) Then
' filesys.CopyFolder SRCobjsubfolder.path , DESTobjsubfolder.path
For Each file In SRCobjSubfolder.Files
objFSO.CopyFile file.Path, DESTobjSubfolder & "\"
Next
End If
Next
Next

wscript.echo "Done"

Set objFSO = Nothing
Set filesys = Nothing

 

[abenitez77]

Ok, this is how far i got. I am able to create new folders but when the folder has a prefix and is larger than 5, it creates a new one instead of copying into the existing folder with a prefix. i.e.

source folders:
12345
44444
99999
33333

destination folders which exists:
12345
99999
x33333

folders 12345 and 99999 should copy all files from source to destination. source folder 33333 should copy the files in the folder to destination folder named x33333. See my code below:

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set filesys=CreateObject("Scripting.FileSystemObject")

Set SRCobjFolder = objFSO.GetFolder("C:\Data\BCF\Images")
Set SRCcolSubfolders = SRCobjFolder.Subfolders

Set DESTobjFolder = objFSO.GetFolder("C:\Data\ANP\Images")
Set DESTcolSubfolders = DESTobjFolder.Subfolders

Dim filesys
Dim Folder

' Loop thru every Source Folder.
For Each SRCobjSubfolder in SRCcolSubfolders
' Look to see if folder exists in Destination.
' Check if same exact folder name exists in both source and destination.
If objFSO.FolderExists(DESTobjFolder & "\" & SRCobjSubfolder.Name) Then
' Loop thru each destination looking for the source folder.
For Each DESTobjSubfolder In DESTcolsubfolders
' Compare Destination folder with Source folder.
If Right(DESTobjsubfolder.Name,5) = SRCobjsubfolder.Name Then
' filesys.CopyFolder SRCobjsubfolder.path , DESTobjsubfolder.path
For Each file In SRCobjSubfolder.Files
'If dateDiff("d", file.DateCreated, Date) < 1 Then 'copy file if it's "1 days old"
'wscript.echo "Copy : " & file.Path & " TO: " & DESTobjSubfolder & "\"
objFSO.CopyFile file.Path, DESTobjsubfolder & "\"
'End If
Next
End If
Next

Else
For Each DESTobjSubfolder In DESTcolsubfolders
' Check to see if folder folders were imported and prefix was added.
Wscript.echo "destination folder name: " & DESTobjsubfolder.Name & " Len: " & cstr(Len(DESTobjsubfolder.Name)) & " Source: " & SRCobjsubfolder.Name
If Right(DESTobjsubfolder.Name,5) = SRCobjsubfolder.Name And Len(DESTobjsubfolder.Name) > 5 Then
For Each file In SRCobjSubfolder.Files
'If dateDiff("d", file.DateCreated, Date) < 1 Then 'copy file if it's "1 days old"
' Copy Files from Source to Destination Folder.
objFSO.CopyFile file.Path, DESTobjFolder & "\" & DESTobjsubfolder.Name & "\"
'End If
Next
Exit For
Else
wscript.echo " destination99: " & SRCobjFolder & "\" & Right(DESTobjSubfolder.Name,5)

If objFSO.FolderExists(SRCobjFolder & "\" & Right(DESTobjSubfolder.Name,5)) AND Right(DESTobjsubfolder.Name,5) <> SRCobjsubfolder.Name And Len(DESTobjsubfolder.Name) > 5 Then
wscript.echo "it exists"
Else
' Folder never existed in destination, Creating folder in destination path.
wscript.echo "creating : " & (DESTobjFolder & "\" & SRCobjsubfolder.Name)
objFSO.CreateFolder (DESTobjFolder & "\" & SRCobjsubfolder.Name)
' Copies all the files from source folder to destination folder.
For Each file In SRCobjSubfolder.Files
'If dateDiff("d", file.DateCreated, Date) < 1 Then 'copy file if it's "1 days old"
' Copy Files from Source to Destination Folder.
objFSO.CopyFile file.Path, DESTobjFolder & "\" & SRCobjsubfolder.Name & "\"
Next
Exit For
End If
End If
Next
End if

Next

wscript.echo "Done"

Set objFSO = Nothing
Set filesys = Nothing

 

[abenitez77]

Sometimes you just need to step away from the problem and come back fresh. Here is the complete solution for anyone who can use it. Feel free to improve on it.

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set filesys=CreateObject("Scripting.FileSystemObject")

Set SRCobjFolder = objFSO.GetFolder("C:\Data\BCF\Images")
Set SRCcolSubfolders = SRCobjFolder.Subfolders

Set DESTobjFolder = objFSO.GetFolder("C:\Data\ANP\Images")
Set DESTcolSubfolders = DESTobjFolder.Subfolders

Dim filesys
Dim Folder
Dim CreateFolder

' Loop thru every Source Folder.
For Each SRCobjSubfolder in SRCcolSubfolders

' Check if same exact folder name exists in both source and destination.
If objFSO.FolderExists(DESTobjFolder & "\" & SRCobjSubfolder.Name) Then
' Loop thru each destination looking for the source folder.
For Each DESTobjSubfolder In DESTcolsubfolders
' Compare Destination folder with Source folder.
If Right(DESTobjsubfolder.Name,5) = SRCobjsubfolder.Name Then
' filesys.CopyFolder SRCobjsubfolder.path , DESTobjsubfolder.path
For Each file In SRCobjSubfolder.Files
'If dateDiff("d", file.DateCreated, Date) < 1 Then 'copy file if it's "1 days old"
'wscript.echo "Copy : " & file.Path & " TO: " & DESTobjSubfolder & "\"
objFSO.CopyFile file.Path, DESTobjsubfolder & "\"
'End If
Next
End If
Next

Else

CreateFolder = True
' Loop thru each destination looking for the source folder.
For Each DESTobjSubfolder In DESTcolsubfolders
' Check to see if folder folders were imported and prefix was added.
'Wscript.echo "destination folder name: " & DESTobjsubfolder.Name & " Len: " & cstr(Len(DESTobjsubfolder.Name)) & " Source: " & SRCobjsubfolder.Name
If Right(DESTobjsubfolder.Name,5) = SRCobjsubfolder.Name And Len(DESTobjsubfolder.Name) > 5 Then
' Copies all the files from source folder to destination folder.
For Each file In SRCobjSubfolder.Files
'If dateDiff("d", file.DateCreated, Date) < 1 Then 'copy file if it's "1 days old"
' Copy Files from Source to Destination Folder.
objFSO.CopyFile file.Path, DESTobjFolder & "\" & DESTobjsubfolder.Name & "\"
Next
CreateFolder = False
End If
Next

If CreateFolder = True Then
objFSO.CreateFolder (DESTobjFolder & "\" & SRCobjsubfolder.Name)
' Copies all the files from source folder to destination folder.
For Each file In SRCobjSubfolder.Files
'If dateDiff("d", file.DateCreated, Date) < 1 Then 'copy file if it's "1 days old"
' Copy Files from Source to Destination Folder.
objFSO.CopyFile file.Path, DESTobjFolder & "\" & SRCobjsubfolder.Name & "\"
Next
End If

End If

Next

wscript.echo "Done"

Set objFSO = Nothing
Set filesys = Nothing