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.
Advertisements
|