Enumerate subfolders and run robocopy job for each subfolder

I am using Robocopy to sync data directories.  The total volume of data is around 100 GB and although the amount of data that changes daily and needs to be sync'd is small, it takes an exceptionally long time for a single Robocopy job to work it's way through all of the subdirectories and finish.  I have found that if I create separate robocopy jobs, one for each subdirectory off the main folder then I performance is greatly enhanced.  So what I would like to do is create a script that enumerates all the subfolders and then runs a robocopy job for each subfolder enumerated.  

I would like to modify this script (below).  The diference is that this script reads from a text file to start the jobs.  It works well until a folder is added I forget to update the text file.  Thanks for your help.


Option Explicit

Dim objShell, objFSO
Dim strOptions, strLog, strSource, strDestination, strFolder
Dim txtFile, strFileName, strPath

Set objShell =       CreateObject("WScript.Shell")      ' Instantiate the Windows Script Host
Set objFSO =       CreateObject("Scripting.FileSystemObject")      'Instatiate the File System Object (FSO)
Set txtFile =       objFSO.OpenTextFile("Robocopy_File.txt", 1)      'Open File with FSO


do until txtFile.AtEndOfStream  '      Loops through the file "Robocopy_File.txt" starting jobs for each line in the file.
        strFolder      = txtFile.ReadLine            'Open Robocopy_File.txt
        strSource      = "\\olyfile02\billimages$" & "\" & strFolder      'Copy source
        strDestination = "\\prodfile01\billimages$" & "\" & strFolder      'Copy Destination
        strOptions       = " /XF *.tif /S /maxage:1095 /R:5 /w:2 /NFL /NDL /TEE "      'Robocopy options.  See Below.
       strLog         = strFolder & ".log"      'Log file name.  Each job creates a unique log file.
      objShell.Run "Robocopy "& strSource & " " & strDestination & " " & strOptions & " /log:" & strLog
      WScript.Sleep 500
loop
txtFile.Close