Recursive folder synchronization using VBScript

This code synchronizes the contents (files and subfolders) of two folders. Each folder is traversed recursively and any missing subfolders and files are copied both ways. If corresponding folders contain files with matching file names but with different time stamps, the file with the newest time stamp will overwrite the older.

Updated 2012-09-09: Fixed exponential call count bug. Performance is now much better on deeper tree structures. Thanks to X for discovering and reporting the bug.

Save the script as SyncFolders.vbs.

Option Explicit

ForceScriptEngine("cscript")

Dim wshArgs
Set wshArgs = Wscript.Arguments
If WshArgs.Count = 2 Then
  Call SyncFolders(WshArgs.Item(0), WshArgs.Item(1))
  ' Also run once in reverse to catch mismatching subfolder count:
  Call SyncFolders(WshArgs.Item(1), WshArgs.Item(0))
Else
  Wscript.Echo("Wrong number of arguments. Syntax: SyncFolders Folder1 Folder2")
  Wscript.Sleep(3000) ' To allow Function syntax popup message to be seen.
End If

Sub SyncFolders(strFolder1, strFolder2)
  Dim objFileSys
  Dim objFolder1
  Dim objFolder2
  Dim objFile1
  Dim objFile2
  Dim objSubFolder
  Dim arrFolders
  Dim i
  Set objFileSys = CreateObject("Scripting.FileSystemObject")
  arrFolders = Array(strFolder1, strFolder2)
  For i = 0 To 1 ' Make sure that missing folders are created first:
    If objFileSys.FolderExists(arrFolders(i)) = False Then
      wscript.echo("Creating folder " & arrFolders(i))
      objFileSys.CreateFolder(arrFolders(i))
    End If
  Next
  Set objFolder1 = objFileSys.GetFolder(strFolder1)
  Set objFolder2 = objFileSys.GetFolder(strFolder2)
  For i = 0 To 1
    If i = 1 Then ' Reverse direction of file compare in second run
      Set objFolder1 = objFileSys.GetFolder(strFolder2)
      Set objFolder2 = objFileSys.GetFolder(strFolder1)
    End If
    For Each objFile1 in objFolder1.files
      If Not objFileSys.FileExists(objFolder2 & "\" & objFile1.name) Then
        Wscript.Echo("Copying " & objFolder1 & "\" & objFile1.name & _
          " to " & objFolder2 & "\" & objFile1.name)
        objFileSys.CopyFile objFolder1 & "\" & objFile1.name, _
          objFolder2 & "\" & objFile1.name
      Else
        Set objFile2 = objFileSys.GetFile(objFolder2 & "\" & objFile1.name)
        If objFile1.DateLastModified > objFile2.DateLastModified Then
          Wscript.Echo("Overwriting " & objFolder2 & "\" & objFile1.name & _
            " with " & objFolder1 & "\" & objFile1.name)
          objFileSys.CopyFile objFolder1 & "\" & objFile1.name, _
            objFolder2 & "\" & objFile1.name    
        End If
      End If
    Next
  Next
  For Each objSubFolder in objFolder1.subFolders
    Call SyncFolders(strFolder1 & "\" & objSubFolder.name, strFolder2 & _
      "\" & objSubFolder.name)
  Next
  Set objFileSys = Nothing
End Sub

Sub ForceScriptEngine(strScriptEng)
  ' Forces this script to be run under the desired scripting host.
  ' Valid arguments are "wscript" or "cscript".
  ' The command line arguments are passed on to the new call.
  Dim arrArgs
  Dim strArgs
  For Each arrArgs In WScript.Arguments
    strArgs = strArgs & " " & Chr(34) & arrArgs & Chr(34)
  Next
  If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then
    If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
      CreateObject("Wscript.Shell").Run "cscript.exe //Nologo " & _
        Chr(34) & Wscript.ScriptFullName & Chr(34) & strArgs
      Wscript.Quit
    End If
  Else
    If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
      CreateObject("Wscript.Shell").Run "wscript.exe " & Chr(34) & _
        Wscript.ScriptFullName & Chr(34) & strArgs
      Wscript.Quit
    End If
  End If
End Sub

If only a one-way sync is needed (meaning only folder2 is modified), use this version:

Option Explicit

ForceScriptEngine("cscript")

Dim wshArgs
Set wshArgs = Wscript.Arguments
If WshArgs.Count = 2 Then
  Call SyncFolders(WshArgs.Item(0), WshArgs.Item(1))
Else
  Wscript.Echo("Wrong number of arguments. Syntax: SyncFolders Folder1 Folder2")
  Wscript.Sleep(3000) ' To allow Function syntax popup message to be seen.
End If

Sub SyncFolders(strFolder1, strFolder2)
  ' Note: This version only copies from folder1 to folder2
  Dim objFileSys
  Dim objFolder1
  Dim objFolder2
  Dim objFile1
  Dim objFile2
  Dim objSubFolder
  Dim arrFolders
  Dim i
  arrFolders = Array(strFolder1, strFolder2)
  Set objFileSys = CreateObject("Scripting.FileSystemObject")
  For i = 0 To 1 ' Make sure that missing folders are created first:
    If objFileSys.FolderExists(arrFolders(i)) = False Then
      wscript.echo("Creating folder " & arrFolders(i))
      objFileSys.CreateFolder(arrFolders(i))
    End If
  Next
  Set objFolder1 = objFileSys.GetFolder(strFolder1)
  Set objFolder2 = objFileSys.GetFolder(strFolder2)
  For Each objFile1 in objFolder1.files
    If Not objFileSys.FileExists(objFolder2 & "\" & objFile1.name) Then
      Wscript.Echo("Copying " & objFolder1 & "\" & objFile1.name & _
        " to " & objFolder2 & "\" & objFile1.name)
      objFileSys.CopyFile objFolder1 & "\" & objFile1.name, _
        objFolder2 & "\" & objFile1.name
    Else
      Set objFile2 = objFileSys.GetFile(objFolder2 & "\" & objFile1.name)
      If objFile1.DateLastModified > objFile2.DateLastModified Then
        Wscript.Echo("Overwriting " & objFolder2 & "\" & objFile1.name & _
          " with " & objFolder1 & "\" & objFile1.name)
        objFileSys.CopyFile objFolder1 & "\" & objFile1.name, _
          objFolder2 & "\" & objFile1.name    
      End If
    End If
  Next
  For Each objSubFolder in objFolder1.subFolders
    Call SyncFolders(strFolder1 & "\" & objSubFolder.name, strFolder2 & _
      "\" & objSubFolder.name)
  Next
  Set objFileSys = Nothing
End Sub

Sub ForceScriptEngine(strScriptEng)
  ' Forces this script to be run under the desired scripting host.
  ' Valid arguments are "wscript" or "cscript".
  ' The command line arguments are passed on to the new call.
  Dim arrArgs
  Dim strArgs
  For Each arrArgs In WScript.Arguments
    strArgs = strArgs & " " & Chr(34) & arrArgs & Chr(34)
  Next
  If Lcase(Right(Wscript.FullName, 12)) = "\wscript.exe" Then
    If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
      CreateObject("Wscript.Shell").Run "cscript.exe //Nologo " & _
        Chr(34) & Wscript.ScriptFullName & Chr(34) & strArgs
      Wscript.Quit
    End If
  Else
    If Instr(1, Wscript.FullName, strScriptEng, 1) = 0 Then
      CreateObject("Wscript.Shell").Run "wscript.exe " & Chr(34) & _
        Wscript.ScriptFullName & Chr(34) & strArgs
      Wscript.Quit
    End If
  End If
End Sub
Page last updated 2012-09-09 13:25. Some rights reserved (CC by 3.0)

Search

Feeds

RSS 2.0 feed All content
RSS 2.0 feed ajax
RSS 2.0 feed asp
RSS 2.0 feed aspnet
RSS 2.0 feed bicycle
RSS 2.0 feed copenhagen
RSS 2.0 feed databases
RSS 2.0 feed denmark
RSS 2.0 feed diy
RSS 2.0 feed dotnet
RSS 2.0 feed html
RSS 2.0 feed japan
RSS 2.0 feed javascript
RSS 2.0 feed modding
RSS 2.0 feed photography
RSS 2.0 feed utilities
RSS 2.0 feed vbscript