Backup Files/Folders If File/Folder Has Been Modified

By | October 11, 2007

At the last job I worked at they had a shared folder. In this folder they would put scanned documents. The only problem was sometimes they updated documents or created new sub folders.
This script will copy all updated files, over writing the previous ones using the date modified as a comparison. It will also copy subfolders to the backup destination as they are created.
It will not delete files if the name of the file has changed.

Now this script is a little complex, but if you follow the instructions at the bottom, you should be fine.

———-COPY EVERYTHING BELOW THIS LINE for the Script———-
' Backup files and folders on a server.
' Created 5.10.07 by Cheyenne Harden

On Error Resume Next

Const OverwriteExisting = True
Dim arrPath(), arrFiles()
Dim strDestination, strDestination1, strSource, strSource1, strComputer, strPath, strResult
Dim strObj, objFSONew1, objFileNew1, strFile, objFSONew, objFileNew
Dim objFileSys, objFolder, objWMIService, intSize, intFileSize, colFileList
Dim FSO, FSO1, objFSO, objFSO2, objFSO3, Result, Result2

strDestination = 0
strSource = 0
intSize = 0
intFileSize = 0
strComputer = "."
strPath = "\\YOUR DESTINATION SERVER NAME HERE\PATH\" ' Place your unc path here

'Folder Creation
Set FSO1 = CreateObject("Scripting.FileSystemObject")
ListSubfolders FSO1.GetFolder("C:\SOURCE FILES") ' Place the source path here

 Function ListSubFolders(Folder)
  For Each Subfolder in Folder.SubFolders
    'WScript.Echo Subfolder.Path
   ListSubFolders Subfolder
     'WScript.Echo Subfolder
   strResult = Replace(Subfolder, "C:\SOURCE FILES\", strPath) ' Place the source path here
     'WScript.Echo strResult
    ReDim Preserve arrPath(intSize)
    arrPath(intSize) = strResult
    intSize = intsize + 1
  Next 
 End Function
 
 
'The Items below are for trouble shooting 
  'WScript.Echo intSize
  'WScript.Echo arrPath(0)
  'WScript.Echo arrPath(1)
  'WScript.Echo arrPath(2)

FolderExists()

 Function FolderExists()
  Do Until intSize < 1
  Set objFileSys = CreateObject("Scripting.FileSystemObject")
  
   If objFileSys.FolderExists(arrPath(intSize – 1)) Then
     'WScript.Echo "Folder Exists"
   Else
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objFolder = objFSO.CreateFolder(arrPath(intSize – 1))
   End If
   
  intSize = intSize – 1 
  Loop
 End Function

'Below uses recursion on folders to copy files
Set FSO = CreateObject("Scripting.FileSystemObject")
ShowSubfolders FSO.GetFolder("C:\SOURCE FILES") ' Place source path here

 Function ShowSubFolders(Folder)
  For Each Subfolder in Folder.SubFolders
    'WScript.Echo Subfolder.Path
   ShowSubFolders Subfolder
  
   strComputer = "."
   Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
   Set colFileList = objWMIService.ExecQuery _
    ("ASSOCIATORS OF {Win32_Directory.Name='" & Subfolder & "'} Where " & "ResultClass = CIM_DataFile")

  
   For Each objFile In colFileList
     'WScript.Echo objFile.Name
    strObj = objFile.Name
      'WScript.Echo "Creation date: " & objFile.LastModified
   
    Set objFSONew1 = CreateObject("Scripting.FileSystemObject")
    Set objFileNew1 = objFSONew1.GetFile(strObj)
     strSource = objFileNew1.DateLastModified
       'WScript.Echo strSource
     strSource1 = Left(strSource,14)
     strFile = Replace(strObj, "C:\SOURCE FILES\", "\\DESTINATION SERVER NAME HERE\PATH\") 'Place source and then destination path here
       'WScript.Echo strFile
   
    'Set objFSONew = CreateObject("Scripting.FileSystemObject")
    'Set objFileNew = objFSONew.GetFile(strFile)
       'WScript.Echo objFileNew.DateLastModified
     'strDestination = objFileNew.DateLastModified
     'strDestination1 = Left(strDestination,14)
        
       'WScript.Echo strPath
       'WScript.Echo strFile
    Set objFSO2 = CreateObject("Scripting.FileSystemObject")
    Set objFSO3 = CreateObject("Scripting.FileSystemObject")
      'WScript.Echo strSource1
      'WScript.Echo strDestination1
     
     If objFSO2.FileExists(strFile) Then
       'WScript.Echo "File does exist."
      Set objFSONew = CreateObject("Scripting.FileSystemObject")
      Set objFileNew = objFSONew.GetFile(strFile)
        'WScript.Echo objFileNew.DateLastModified
      strDestination = objFileNew.DateLastModified
      strDestination1 = Left(strDestination,14)
      
       If  strSource1 >  strDestination1 Then
        Result = InStrRev(strFile, "\")
        Result2 = Left(strFile, Result)
         'WScript.Echo Result2
        Set objFSO3 = CreateObject("Scripting.FileSystemObject")
        objFSO3.CopyFile objFile.Name , Result2, OverwriteExisting
     
       Else
         'WScript.Echo "Files are Equal!"
       End If
     
     Else
       'WScript.Echo "File does not exist."
       'Subfolder = Subfolder & "\"
      Result = InStrRev(strFile, "\")
      Result2 = Left(strFile, Result)
       'WScript.Echo Result2
      Set objFSO3 = CreateObject("Scripting.FileSystemObject")
      objFSO3.CopyFile objFile.Name , Result2, OverwriteExisting
     End If

   Next
   
  Next
  
 End Function

———-COPY EVERYTHING ABOVE THIS LINE for the Script———-

 

PLEASE MAKE SURE NO WORD WRAPPING IS HAPPENING IN YOUR SCRIPT!!!

1. Create a scheduled task for this script to run.
2. The task needs to have access to the source and destination files.
3. Place your UNC path here:   strPath = "\\YOUR DESTINATION SERVER NAME HERE\PATH\"
4. Place the source path here: ListSubfolders FSO1.GetFolder("C:\SOURCE FILES")
5. Place the source path here strResult = Replace(Subfolder, "C:\SOURCE FILES\", strPath)
6. Place source path here: ShowSubfolders FSO.GetFolder("c:\SOURCE FILES")
7. Place source and then destination path here: strFile = Replace(strObj, "C:\SOURCE FILES\", "\\DESTINATION SERVER NAME HERE\PATH\")
8. There are many lines commented out. You can un-Comment them for trouble shooting! Just remove the single quote at the beginning of the line.

This information is provided "AS IS" with no warranties expressed or implied.

Leave a Reply

Your email address will not be published. Required fields are marked *