Vbscript - Checking each subfolder for files and copy files

I'm trying to get this script to work. It's basically supposed to mirror two sets of folders and make sure they are exactly the same. If a folder is missing, the folder and it's content should be copied.

Then the script should compare the DateModified attribute and only copy the files if the source file is newer than the destination file.

I'm trying to get together a script that does exactly that. And so far I've been able to check all subfolder if they exist and then create them if they don't. Then I've been able to scan the top source folder for it's files and copy them if they don't exist or if the DateModified attribute is newer on the source file.

What remains is basically scanning each subfolder for its files and copy them if they don't exist or if the DateModified stamp is newer.

Here's the code:

Dim strSourceFolder, strDestFolder

strSourceFolder = "c:\users\vegsan\desktop\Source\"
strDestFolder = "c:\users\vegsan\desktop\Dest\"

Set fso = CreateObject("Scripting.FileSystemObject")
Set objTopFolder = fso.GetFolder(strSourceFolder)
Set colTopFiles = objTopFolder.Files

'Check to see if subfolders actually exist. Create if they don't
Set objColFolders = objTopFolder.SubFolders
For Each subFolder in objColFolders
    CheckFolder subFolder, strSourceFolder, strDestFolder
Next

' Check all files in first top folder
For Each objFile in colTopFiles
    CheckFiles objFile, strSourceFolder, strDestFolder
Next

Sub CheckFolder (strSubFolder, strSourceFolder, strDestFolder)
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim folderName, aSplit

    aSplit = Split (strSubFolder, "\")
    UBound (aSplit)

    If UBound (aSplit) > 1 Then
        folderName = aSplit(UBound(aSplit))
        folderName = strDestFolder & folderName
    End if

    If Not fso.FolderExists(folderName) Then
        fso.CreateFolder(folderName)
    End if

End Sub

Sub CheckFiles (file, SourceFolder, DestFolder)

    Set fso = CreateObject("Scripting.FileSystemObject开发者_C百科")
        Dim DateModified
        DateModified = file.DateLastModified
        ReplaceIfNewer file, DateMofidied, SourceFolder, DestFolder
End Sub


Sub ReplaceIfNewer (sourceFile, DateModified, SourceFolder, DestFolder)

    Const OVERWRITE_EXISTING = True
    Dim fso, objFolder, colFiles, sourceFileName, destFileName
    Dim DestDateModified, objDestFile

    Set fso = CreateObject("Scripting.FileSystemObject")

    sourceFileName = fso.GetFileName(sourceFile)
    destFileName = DestFolder & sourceFileName

    if Not fso.FileExists(destFileName) Then
        fso.CopyFile sourceFile, destFileName

    End if

    if fso.FileExists(destFileName) Then

        Set objDestFile = fso.GetFile(destFileName)
        DestDateModified = objDestFile.DateLastModified


        if DateModified <> DestDateModified Then
            fso.CopyFile sourceFile, destFileName
        End if

    End if

End Sub

I know this is an old post but I have been looking for a way to run VBS to copy and backup data based on date modified and run through all sub directories and files and stumbled across a solution based on the above question

your code has an error in the line

ReplaceIfNewer file, DateMofidied, SourceFolder, DestFolder

you have DateModified miss-spelled causing this to not send through your file.datelastmodified on to your sub. Other then that your code was copying the first levels of files and folders once I repaired that.

I have built on this code to copy multiple levels of subdirectories and copy files in each corespondng subdirectory by calling the sub again within itself renaming the source folder everytime with a dynamic array.

This set of code will compare the two files and replace the older with the newer. see code:

Dim i
Dim defaultchoice
Dim Defaultuser
Dim Theday
Dim Source
Dim driveletter 
Dim backup1 
Dim destin
Dim objshell
Dim objf
Dim Bsplit
Dim k
Dim total
Dim SourceFolder 
Dim DestFolder
Dim objFSO
Dim Objfolder
Dim Msg1


'**********************************************************
' Start off your arrays at zero
'**********************************************************
i=0


'**********************************************************
'set default choice to 1 run with user input to select source and destination or 0 to follow below schedule
'**********************************************************
defaultchoice = 0
Defaultuser = "*******"


Set objFSO = CreateObject("Scripting.FileSystemObject")

'**********************************************************
' Define default locations where you get data and where you want to put it depending on the day, BAcking up something different every day in the week
'**********************************************************
Theday = weekday(now())

if Theday = 2 then
    Source = "U:\**"
    destin = "H:\**\Backups"
elseif Theday = 4 then
    Source ="C:\***\backups"
    destin = "H:\***\Backups"
elseif Theday = 3 then
    Source ="U:\****"
    destin = "H:\****\Backups"
elseif Theday = 5 then
    Source ="C:\Users\*****\Documents"
    destin = "H:\*****\Backups"
elseif Theday = 6 then
    Source = "L:\******\data"
    destin = "H:\******\Backups"

else
    Wscript.Quit
end if

if defaultchoice = 1 then
    MSG1 = MsgBox("Do you wish to manually enter your location",vbyesno,"Select")
    If MSG1 = vbyes then
        Source = inputbox("Enter the file location you wish to get data from",,Source)
        Destin = inputbox("Enter the file location you wish to Backup to",,destin)
    else    
        Set objShell = CreateObject("Shell.Application")
        Set objF = objShell.BrowseForFolder(0, "Choose folder to get data from", 0, 17)
        checkfolderagain objf
        source = objF.self.path

        Destin = inputbox("Enter the file location you wish to Backup to",,destin)
    end if

end if

'**********************************************************
' Check to see if your source exists
'**********************************************************
If objFSO.FolderExists(Source) Then
'**********************************************************
' Create Destination folder if it doesn't exist
'**********************************************************

    BSplit = Split (destin, "\")
    total = UBound (BSplit)
    Backup1= Bsplit(i)
    If objfso.FolderExists(Backup1) Then
        For k= 1 to total
        Backup1= Backup1 & "\" & Bsplit(k)
        If objFSO.FolderExists (backup1) Then
        Else
            Set objFolder = objFSO.CreateFolder(backup1)
        End If
        next
    else
        Msgbox("Destination Drive does not exist")
        Wscript.Quit
    end if

'**********************************************************
' Format to utilize the Get folder command
'**********************************************************

    SourceFolder = source & "\"
    DestFolder = destin & "\"

'**********************************************************
' Execute the Sub to write files and sub folders
'**********************************************************
    copyfirstfilesandsubs Sourcefolder, Destfolder      
else
    Msgbox("Source folder does not exist")
end if

set i = nothing
Set defaultchoice = nothing
set Defaultuser = nothing
Set Theday = nothing
set Source = nothing
set driveletter = nothing 
set backup1 = nothing 
set destin = nothing
Set objshell = nothing
Set objf = nothing
Set Bsplit = nothing
Set k = nothing
Set total = nothing
set objFSO = nothing
set Objfolder = nothing
Set Msg1 = nothing

'**********************************************************
' first copy each file in top directory then create each subfolder
'**********************************************************
Sub copyfirstfilesandsubs(strsourcefolder,strdestfolder)

'**********************************************************
' Get the files that are in source folder and define top folder
'********************************************************** 
    Dim objColFolders
    Dim colTopFiles
    Dim objTopFolder

    Set objTopFolder = objfso.GetFolder(strsourcefolder)
    Set colTopFiles = objTopFolder.Files

    For Each objFile in colTopFiles
        CheckFiles objFile, strSourceFolder, strDestFolder
    Next

    Set objColFolders = objTopFolder.SubFolders
    For Each subFolder in objColFolders
        CheckFolder subFolder, strSourceFolder, strDestFolder
    next

    set objColFolders = nothing
    Set colTopFiles = nothing
    Set objTopFolder = nothing
end sub

'**********************************************************
' looks at modified date and sends date to ReplaceIfNewer
'**********************************************************
Sub CheckFiles (file, CFSourceFolder, CFDestFolder)

    Dim DateModified
    DateModified = file.DateLastModified
    ReplaceIfNewer file, DateModified, CFSourceFolder, CFDestFolder
End Sub

'**********************************************************
'copys file if it doesn't exist or updates whichever version of the file is older or does nothing if they are equal
'**********************************************************
Sub ReplaceIfNewer (File, DateModified, CFSourceFolder, CFDestFolder)
    Dim sourcefilename, destFileName, objDestFile, DestDateModified

    Const OVERWRITEEXISTING = True
    sourceFileName = objfso.GetFileName(File)
    destFileName = CFDestFolder & sourceFileName
    if objfso.FileExists(destFileName) Then
        Set objDestFile = objfso.GetFile(destFileName)
            DestDateModified = objDestFile.DateLastModified 
    if DateModified > DestDateModified Then
                objfso.CopyFile File, destFileName, OVERWRITEEXISTING
        elseif DateModified < DestDateModified Then
                objfso.CopyFile destFileName, File, OVERWRITEEXISTING
        End if
    else
        objfso.CopyFile File, destFileName

    End if
End Sub

'**********************************************************
'Creates folder if it currently doesn not exist, Creates new source folder path based on the folder it is in and repeats process at lower level.
'**********************************************************
Sub CheckFolder (SubFolder, cfoSourceFolder, cfoDestFolder)

    Dim foldername
    Dim asplit
    Dim chkdestfolder
    Dim SourceFolder2()
    Dim DestFolder2()

        aSplit = Split (SubFolder, "\")
    UBound (aSplit)
        If UBound (aSplit) > 1 Then
         folderName = aSplit(UBound(aSplit))                

    End if
    chkdestfolder = cfoDestFolder  & folderName
'**********************************************************
'Identify any folders that you don't have permissions to copy from they will error out as you do not have permission to this folder
'**********************************************************
    if subfolder = "C:\Users\" & defaultuser & "\Documents\My Shapes" or subfolder="C:\Users\" & defaultuser & "\Documents\My Music" or subfolder="C:\Users\" & defaultuser & "\Documents\My Pictures"or subfolder="C:\Users\" & defaultuser & "\Documents\My Videos" then  
    else
    If Not objfso.FolderExists(chkdestfolder) Then
        objfso.CreateFolder(chkdestfolder)
    End if

    i=i+1

'**********************************************************
'Redefine Source folder  and destination folder one level deeper    
'**********************************************************
    ReDim Preserve SourceFolder2(i)
    ReDim Preserve DestFolder2(i)
    SourceFolder2(i) = cfoSourceFolder & foldername & "\"
    DestFolder2(i) = chkdestfolder & "\"

'**********************************************************
'Execute the sub to write folders within the subfolder you just created 
'**********************************************************
    copyfirstfilesandsubs SourceFolder2(i), DestFolder2(i)
    end if
    set foldername = nothing 
    set asplit = nothing  
    set chkdestfolder = nothing 
End Sub

Sub checkfolderagain (objf)
        If objF Is Nothing Then    
            Wscript.Quit
        End If
end sub

I'm sure this code is delightful, but syncing two folders is a common problem and there are free utilities included with Windows that will do it so you don't need to write and maintain this code. ROBOCOPY is a good place to start. See also XCOPY or open source alternatives such as rsync.