This is a script written years ago that I still find useful; I had a need to apply updates to many local machines that had no network access from an external hard drive. It 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 timestamps, the file with the oldest timestamp will be overwritten.
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
When only one-way sync is needed (only folder 2 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