I created this script (My 1st proper grown up one!) to assist our build guys at work to backup files/folders on old PC's before they swap them out.
It asks where you want the files to be backed up to (C:\FolderName) or even (\\ServerName\Volume\Folder).
Then asks for file types to backup (doc, xls, txt)
Asks which user profiles to backup.
It then backsup all the file types as requested retaining the folder structure.
And then backsup the "My Documents", "favorites" & "Notes Data" folders from the profiles requested.
The script could be altered to include any folders on the PC that you require.
Oh and it writes a logfile to show what was copied.
In theory you could run this on your PC and remotely backup PC by changing line Set objWMIService = GetObject("winmgmts:\\.\root\cimv2") to Set objWMIService = GetObject("winmgmts:\\PCNAME\root\cimv2") but I've not tried it!
'==========================================================================
' COMMENT : Script created to backup all necessary and requested files
' for PC replacements.
'
'==========================================================================
'==========================================================================
'
' COMMENT: Copy selected file types to selected destination folder
'
'==========================================================================
On Error Resume Next
'Declare Objects
Dim oFSO, oShell, objWMIService
'Declare Log file
strLogFile = "C:\copylog.txt"
' Create objects
Set objWMIService = GetObject("winmgmts:\\.\root\cimv2")
Set oFSO = CreateObject ("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
'Clear log file if it already exists
If oFSO.FileExists (strLogFile) Then
oFSO.DeleteFile strLogFile, True
End If
'Open input box to set destination path for copy
strDestination = InputBox ("Please enter the destination path for copy :","Destination Folder")
'Split destination into array to grab actual folder to exclude if backing up to local hard drive
'This will elimanate copying the destination folder to itself in the loop (ie C:\archive copying to C:\archive\archive)
arrDestName = Split(strDestination, "\")
intUbound = UBound(arrDestName)
strIgnore = arrDestName(intUbound)
'Check if anything was entered
If strDestination = "" Then
WScript.Quit
End If
'Check if path exists. This prevents copying over previous backups.
'Considered adding a function to delete previous backups but excluded at this time
If oFSO.FolderExists (strDestination) Then
'If exists bombs out
MsgBox ("Destination folder already exist!!")
MsgBox "Quitting!!"
WScript.Quit
Else
'If destination folder doesn't exist then create it
oFSO.CreateFolder strDestination
End If
'Ask users which file types they wish to copy and load into array
sTypes = InputBox("Enter extensions without periods seperated by commas" & VbCrLf & "(eg doc,txt)","File Types")
arrTypes = Split(sTypes,",")
'Ask users which user profiles they wish to copy and load into array
pTypes = InputBox("Which user profiles? (Seperated by commas)","User Profiles")
arrProfile = Split(pTypes,",")
'Cycle through each file type in array
For Each strType In arrTypes
'Check for required file types on C drive
Set colFiles = objWMIService.ExecQuery ("Select * From CIM_DataFile where Extension = '"& strType &"' and Drive ='C:'")
addtolog strLogFile, VbCrLf & strType & VbCrLf
For Each objFile In colFiles
'Split File Path into Array
arrNames = Split(objFile.Path, "\")
intTotal = UBound(arrNames) - 1
intValue = 0
'Reset Folder to root!!
strFolder = strDestination
strFile = objFile.Drive & objFile.Path & objFile.FileName & "." & objFile.Extension
'Create the Folder Structure
Do Until intValue = intTotal
intValue = intValue + 1
'If folder not found then create it
If Not oFSO.FolderExists (strFolder & "\" & arrnames(intvalue)) Then
oFSO.CreateFolder strFolder & "\" & arrnames(intvalue)
End If
'Set folder to NEW folder structure
strFolder = strFolder & "\" & arrNames(intValue)
Loop
'Copy file to NEW folder structure
oFSO.CopyFile strFile, strFolder & "\"
'Check for file after copy
If oFSO.FileExists (strFolder & "\" & objFile.FileName & "." & objFile.Extension) Then
'Write to log
addtolog strLogFile, "COPIED " & strFile & " To " & strFolder & "\" & objFile.FileName & "." & objFile.Extension
Else
addtolog strLogFile, "NOT COPIED " & strFile & " To " & strFolder & "\" & objFile.FileName & "." & objFile.Extension
End If
Next
WScript.Echo "All " & strType & " files copied :)"
Next
'WScript.Echo "All file types copied :) "
'WScript.Echo "Moving onto My Documents folders :) "
'==========================================================================
'
'
' COMMENT: Copy "My Documents" folder and files and all subfolders with files
' except Administrator and Default User profiles
'
'==========================================================================
'Set folder to copy
strName = "my documents"
Set colFolder = objWMIService.ExecQuery ("Select * From Win32_directory where name like '%" & strName & "%' and Drive ='C:'")
For Each objFolder In colFolder
'Split File Path into Array
arrNames = Split(objFolder.Name, "\")
strNewPath = ""
StrRoot = "C:"
IntValue = 0
IntProfileTot = UBound(arrProfile)+1
IntProfileVal = 0
Do while IntProfileVal < IntProfileTot
If InStr((objFolder.Name), strIgnore) Then
'Don't want to copy the destination folder into itself so do Nothing
Else
'Only copy profile(s) as requested from earlier input
If InStr(LCase(objFolder.Name), "settings") And (InStr(LCase(objFolder.Name), arrProfile(IntProfileVal))) Then
'Create the Folder Structure
Do While intValue < 5
intValue = intValue + 1
'If folder not found then create it
If Not oFSO.FolderExists (strDestination & strNewPath) Then
oFSO.CreateFolder strDestination & strNewPath
End If
'Set folder to NEW folder structure
strNewPath = strNewPath & "\" & arrNames(intValue)
Loop
oFSO.CopyFolder StrRoot & strNewPath, StrDestination & strNewPath
addtolog strLogFile, "COPIED " & StrRoot & strNewPath & VbCrLf
End If
End If
IntProfileVal = IntProfileVal + 1
Loop
Next
'WScript.Echo "My Documents folders copied :) "
'WScript.Echo "Moving onto favorites folders :) "
'==========================================================================
'
'
' COMMENT: Copy "Favorites" folder and files and all subfolders with files
' except Administrator and Default User profiles
'
'==========================================================================
strName = "favorites"
Set colFolder = objWMIService.ExecQuery ("Select * From Win32_directory where name like '%" & strName & "%' and Drive ='C:'")
For Each objFolder In colFolder
'Split File Path into Array
arrNames = Split(objFolder.Name, "\")
strNewPath = ""
StrRoot = "C:"
IntValue = 0
IntProfileTot = UBound(arrProfile)+1
IntProfileVal = 0
Do while IntProfileVal < IntProfileTot
If InStr((objFolder.Name), strIgnore) Then
'Don't want to copy the destination folder into itself so do Nothing
Else
'Only copy profile(s) as requested
If InStr(LCase(objFolder.Name), "settings") And (InStr(LCase(objFolder.Name), arrProfile(IntProfileVal))) Then
'Create the Folder Structure
Do While intValue < 5
intValue = intValue + 1
'If folder not found then create it
If Not oFSO.FolderExists (strDestination & strNewPath) Then
oFSO.CreateFolder strDestination & strNewPath
End If
'Set folder to NEW folder structure
strNewPath = strNewPath & "\" & arrNames(intValue)
Loop
oFSO.CopyFolder StrRoot & strNewPath, StrDestination & strNewPath
addtolog strLogFile, "COPIED " & StrRoot & strNewPath & VbCrLf
End If
End If
IntProfileVal = IntProfileVal + 1
Loop
Next
'WScript.Echo "Favourites folders copied :) "
'WScript.Echo "Moving onto Lotus Notes files :) "
'==========================================================================
'
'
' COMMENT: Copy Lotus Notes files from users profiles
' except Administrator and Default User profiles
'
'==========================================================================
Set colFolder = objWMIService.ExecQuery ("Select * from Win32_Directory where filename ='data' and Drive ='C:'")
For Each objFolder In colFolder
IntProfileTot = UBound(arrProfile)+1
IntProfileVal = 0
Do while IntProfileVal < IntProfileTot
If InStr((objFolder.Name), strIgnore) Then
'Don't want to copy the destination folder into itself so do Nothing
Else
If InStr(LCase(objFolder.Name), "notes") and (InStr(LCase(objFolder.Name), arrProfile(IntProfileVal))) Then
'Split File Path into Array
arrNames = Split(objFolder.Name, "\")
intTotal = UBound(arrNames) - 1
intValue = 0
'Reset Folder to root!!
strFolder = strDestination
'Create the Folder Structure
Do Until intValue = intTotal
intValue = intValue + 1
'If folder not found then create it
If Not oFSO.FolderExists (strFolder & "\" & arrnames(intvalue)) Then
oFSO.CreateFolder strFolder & "\" & arrnames(intvalue)
End If
'Set folder to NEW folder structure
strFolder = strFolder & "\" & arrNames(intValue)
Loop
'Copy files to NEW folder structure
oFSO.CopyFile objFolder.Name & "\" & "bookmark.nsf", strFolder & "\"
oFSO.CopyFile objFolder.Name & "\" & "names.nsf", strFolder & "\"
oFSO.CopyFile objFolder.Name & "\" & "desktop5.dsk", strFolder & "\"
oFSO.CopyFile objFolder.Name & "\" & "*.id", strFolder & "\"
addtolog strLogFile, "COPIED C:\Documents and Setting\" & arrNames(2) & "\Application Data\Notes\Data\bookmark.nsf" & VbCrLf
addtolog strLogFile, "COPIED C:\Documents and Setting\" & arrNames(2) & "\Application Data\Notes\Data\names.nsf" & VbCrLf
addtolog strLogFile, "COPIED C:\Documents and Setting\" & arrNames(2) & "\Application Data\Notes\Data\desktop5.dsk" & VbCrLf
addtolog strLogFile, "COPIED C:\Documents and Setting\" & arrNames(2) & "\Application Data\Notes\Data\*.id" & VbCrLf
End If
End If
IntProfileVal = IntProfileVal + 1
Loop
Next
WScript.Echo "ALL COPIED :) "
'Sub rountine to add copy result to log file
Sub addtolog (strFile, strLine)
On Error Resume Next
Dim objFS
If strLine <> "" Then
Set objFs = Wscript.CreateObject("Scripting.FileSystemObject")
Set objMyFile = objFs.OpenTextFile(strFile, 8, True)
objMyFile.WriteLine strLine
objMyFile.Close
End If
End Sub