Vbscript - check each subfolder for files and file copies

I know this is an old post, but I was looking for a way to start VBS to copy and back up data based on date change and execution of all subdirectories and files and came across a solution based on the above question

your code has an error in line

ReplaceIfNewer file, DateMofidied, SourceFolder, DestFolder

      

        
        
        
      

    

you have DateModified miss-spelled forcing this not to send via file.datelastmodified to your sub. The other is that your code was copying the first levels of files and folders after I fixed it.

I built this code to copy multiple levels of subdirectories and copy files to each corespondng subdirectory by calling sub again inside itself, renaming the original folder each time with a dynamic array.

This set of codes compares the two files and replaces them with the older ones. 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