Hello everyone!
I have a script here that I am working on bit by bit...it is my largest script to date and frankly I want to know what everyone thinks and if improvements can be made to the coding? Either by rearranging, compacting, and/or a most effienct way to do the script?
How about it?
'***********************************************************************************
'*
'* File: BCKUP_FILES_957.VBS
'* Created: July 15, 2008
'* Created By: SPC Key, John E.
'* Last Modified: July 26, 2008
'* Version: 1.4
'*
'* Main Function: Backup user files to network share drive.
'*
'* Recommended Screen Resolution: 1280 X 1024
'*
'***********************************************************************************
On error resume next
LogIt("Backup script has started.")
'Set timeout for four (4) hours.
'If script runs longer than four hours,
'the script will be terminated automatically.
'The timeout is measured in seconds.
'14400 seconds equals 4 hours.
WScript.Timeout = 14400
'********************************************************************
'* Declare main variables
'********************************************************************
'Variables are sorted by type, and
'only one type of variable will apear on one line.
'For example, all object variables will be on same line,
'all string variables will be on same line, etc.
Dim objFSO, objUsername, objFolder, objShell, objWMIService(1), objItem, objExplorer, objFile
Dim objProcess, objWMI, objWQL, objResult, objInstance
' Increase "strFolder" array number if more folders are required to be backed up.
Dim strUsername, strComputer, strPath, strFolder(6), strExt, strExcludeFolder
Dim intTime, intHorizontal, intVertical, intFileCount
Dim ColItems, colProcessList
intFileCount = 1
'The current time is stored within the integer to provide an elapsed time at end of script.
intTime=Time
Set objFSO=wscript.CreateObject("Scripting.FileSystemObject")
'This function finds the username of the user running this script.
Set objUsername = createobject("WSCRIPT.Network")
strUsername = objUsername.UserName
'This function finds the directory paths of Windows special folders,
'then stores them in an array of "strFolder" for later use.
'Something neat about this feature is we do not have to search for
'where the users "My Documents" folder might be located. If it is located
'under C drive - no problem; if it is located under D, E, or F drive - no
'problem.
Set objShell = CreateObject("Wscript.Shell")
strFolder(0) = objShell.SpecialFolders.Item("Desktop")
strFolder(1) = objShell.SpecialFolders.Item("MyDocuments")
strFolder(2) = objShell.SpecialFolders.Item("Favorites")
strFolder(3) = objShell.SpecialFolders.Item("Startup")
strFolder(5) = "C:\Documents and Settings\" & strUsername & "\Local Settings\Application Data\Microsoft\Outlook"
strFolder(6) = "C:\Documents and Settings\" & strUsername & "\Application Data\Microsoft\Outlook"
strCountTheFiles = CountTheFiles
'Start error checking.
'On Error Resume Next
'Checking for user folder presence on share drive.
'This line will create user folder in the event of user folders absence.
If Not objFso.FolderExists("\\yonga720j3bt957\USERS\" & strUsername) Then objFso.CreateFolder("\\yonga720j3bt957\USERS\" & strUsername)
ErrCheck
CreateShort
ErrCheck
'The period within the quotes represents current computer this script is running on.
strComputer = "."
'These next lines of code will verify if Outlook is closed.
'If outlook is open, script will prompt notifying user to
'finish using Outlook and then press OK to close Outlook.
Set objWMIService(1) = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
ErrCheck
Set colProcessList = objWMIService(1).ExecQuery("Select * from Win32_Process")
ErrCheck
For Each objProcess in colProcessList
ErrCheck
If objProcess.Name = "OUTLOOK.EXE" then
Msgbox "Microsoft Outlooks was found running. Please save your files, " & _
"then press OK to close Outlook",48,"Outlook Needs to Close"
set objWMI = GetObject("winmgmts:")
objWQL = "select * from win32_process where name='outlook.exe'"
ErrCheck
set objResult = objWMI.ExecQuery(objWQL)
ErrCheck
for each objInstance in objResult
objInstance.Terminate(0)
ErrCheck
next
ErrCheck
End If
ErrCheck
Next
ErrCheck
'These next few lines get a feel for what display dimensions
'that this script is working with. These lines will be used
'to help place the iexplorer window correctly.
Set objWMIService(0) = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
ErrCheck
Set colItems = objWMIService(0).ExecQuery("Select * From Win32_DesktopMonitor")
ErrCheck
For Each objItem in colItems
intHorizontal = objItem.ScreenWidth
intVertical = objItem.ScreenHeight
ErrCheck
Next
'These next four lines of code find the current
'directory that this script is running in. This
'function is is used to prevent errors when
'future(below) codelooks for a animated gif file.
'As long as the gifand this script are in same
'folder, there will beno error when displaying
'the animated image. This also assists in versatility
'when moving script to new users computer - it
'does not matter what folder the file needs to
'be inside.
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
ErrCheck
Set objFile = objFSO.GetFile(strPath)
ErrCheck
strFolder(4) = objFSO.GetParentFolderName(objFile)
'These lines of code excute iexplorer displaying a message and
'a animated gif notifying user that backup task will take several minutes.
Set objExplorer = CreateObject ("InternetExplorer.Application")
ErrCheck
With objExplorer
.Navigate "about:blank"
.ToolBar = 0
.StatusBar = 0
.Left = (intHorizontal - 400) / 2
.Top = (intVertical - 540) / 2
.Width = 330
.Height = 220
.Visible = 1
.Document.Body.Style.Cursor = "wait"
'These commented out lines are a second option for this script.
'If you want NO animated gif with script, use these lines instead.
'objExplorer.Document.Title = "Backup script in progress"
'objExplorer.Document.Body.InnerHTML = "Your backup script is being processed. " _
'& "This might take several minutes to complete."
.Document.Title = "Backup script in progress"
'.Document.Body.InnerHTML = "<img src='file:///" & strFolder(4) & "\progress.gif' height=75 width=75>" & _
.Document.Body.InnerHTML = "<img src='file:///\\yonga720j3bt957\Tech Support\Software\Utility\Tech_Support_Only\All_Users\progress.gif' height=75 width=75>" & _
"<br><br>Your backup is being processed.<br><br>" & _
"This might take several minutes to complete."
End With
Set objExplorer2 = CreateObject ("InternetExplorer.Application")
ErrCheck
With objExplorer2
.Navigate "about:blank"
.ToolBar = 0
.StatusBar = 0
.Left = (intHorizontal - 400) / 2
.Top = (intVertical - 100) / 2
.Width = 330
.Height = 80
.Visible = 1
.Document.Body.Style.Cursor = "wait"
.Document.Title = "File Count"
.Document.Body.InnerHTML = "File " & intFileCount & " of " & strCountTheFiles & " is being processed."
End With
'This a meaty part of the script calling upon the "Backup" sub.
'Format for adding more folders:
'Backup [source],[destination]
Backup strFolder(0),"\\yonga720j3bt957\USERS\" & strUsername & "\Desktop"
ErrCheck
Backup strFolder(1),"\\yonga720j3bt957\USERS\" & strUsername & "\My Documents"
ErrCheck
Backup strFolder(2),"\\yonga720j3bt957\USERS\" & strUsername & "\Favorites"
ErrCheck
Backup strFolder(3),"\\yonga720j3bt957\USERS\" & strUsername & "\Startup"
ErrCheck
Backup strFolder(5),"\\yonga720j3bt957\USERS\" & strUsername & "\Outlook - App Settings"
ErrCheck
Backup strFolder(6),"\\yonga720j3bt957\USERS\" & strUsername & "\Outlook - App Settings"
ErrCheck
'Once backup is complete, this section notifies user and quits IE.
With objExplorer
.Document.Body.InnerHTML = "Your backup is now complete."
.Document.Body.Style.Cursor = "default"
End With
objExplorer2.Quit
Wscript.Sleep 7000
objExplorer.Quit
LogIt("Backup script has finished.")
CleanMemory
'********************************************************************
'* End of Main Script
'********************************************************************
'********************************************************************
'*
'* Sub LogIt()
'* Purpose: Logs any text passed through this sub function.
'* Input: Text
'* Output: Log File
'* Notes: This sub will log events and date/time the occurance.
'*
'********************************************************************
Sub LogIt(strText)
Const ForAppending = 8
'Declair sub variables.
Dim strScriptPath, strDirectory, strFile, strLogUsername
Dim objFileSO, objLogFile, objLogFolder, objTextFile
'This function finds the username of the user running this script.
Set objUsername = createobject("WSCRIPT.Network")
strLogUsername = objUsername.UserName
'Find script name.
strScriptPath = Wscript.ScriptFullName
'Gather script fule file name and store into variable.
Set objFileSO = CreateObject("Scripting.FileSystemObject")
Set objLogFile = objFileSO.GetFile(strScriptPath)
strDirectory = objFileSO.GetParentFolderName(objLogFile)
'Create naming scheme for log file.
strFile = "\BCKUP - " & strLogUsername & ".log"
'Check if folder is created; otherwise, it will be created.
Set objFileSO = CreateObject("Scripting.FileSystemObject")
If objFileSO.FolderExists(strDirectory) Then
Set objLogFolder = objFileSO.GetFolder(strDirectory)
Else
Set objLogFolder = objFileSO.CreateFolder(strDirectory)
End If
'Check if file is created; otherwise, it will be created.
If objFileSO.FileExists(strDirectory & strFile) Then
Set objLogFolder = objFileSO.GetFolder(strDirectory)
Else
Set objLogFile = objFileSO.CreateTextFile(strDirectory & strFile)
End If
'Clean memory
Set objLogFile = Nothing
Set objLogFolder = Nothing
'Write to log file.
Set objTextFile = objFileSO.OpenTextFile(strDirectory & strFile, ForAppending, True)
objTextFile.WriteLine(Now & ": " & strText)
objTextFile.Close
'Clean memory
Set strDirectory = Nothing
Set strFile = Nothing
Set strLogUsername = Nothing
Set objFileSO = Nothing
Set objTextFile = Nothing
Set strScriptPath = Nothing
End Sub
'********************************************************************
'*
'* Sub ErrCheck()
'* Purpose: Check error level and deal with script accordingly.
'* Input: None
'* Output: None
'* Notes: This sub will notify user of error and create log of error.
'*
'********************************************************************
Sub ErrCheck
If Err.Number <> 0 Then
'Log error information to log file within same directory that script is running.
LogIt("There was an error." & vbCrLf & "Error Description: " & Err.Description & VbCrLf & "Error Number: " & Err.Number & VbCrLf & "Error Source: " & Err.Source)
'Grab a hold of IE and terminate.
objExplorer.Quit
Set objExplorer = Nothing
objExplorer2.Quit
Set objExplorer2 = Nothing
'This next line clears the error.
Err.Clear
'Stop the script when error occures.
CleanMemory
WScript.Quit
End If
End Sub
'********************************************************************
'*
'* Sub Backup()
'* Purpose: Backup user files from local computer to network folder that belongs to user.
'* Input: Source - Destination
'* Output: None
'* Notes: This sub will copy every file and folder under the directory passed to it to the network drive.
'*
'********************************************************************
Sub Backup(RepSource,RepDest)
On Error Resume Next
Dim objSource(1), objDest, objDestCompare
Set objSource(0)=objFSO.GetFolder(RepSource)
ErrCheck
'Check if destination folder exists; otherwise, create it.
If Not objFSO.FolderExists(RepDest) Then objFSO.CreateFolder(RepDest)
ErrCheck
'Begin processing each file under folder
For each objFile in objSource(0).Files
'This next line of code finds the extension of the file, and
'stores it in the variable. This is important becuase it works
'closely with the function we need to exclude certain files, like
'MP3, WAV, etc.
strExt = Right(objFile.Name,4)
ErrCheck
'These next two lines check if file is either a system file or hidden file.
'If the file is either one, the file will be ignored; therefore, not
'being copied. This check was added based on the fact that this script will
'attempt to copy everything with the folder - this posed a problem when it
'tried to copy a file that it did not have permissions too.
'If objFile.Attributes AND 2 Then
'Else If objFile.Attributes AND 4 Then
'********************************************************************
'* EXCLUDE FILE EXTENSIONS
'********************************************************************
'Exclude files - This next line will contain all file extensions that are
'to be excluded when backing up files. Very important line. Also to add
'more extensions to be blocked - simply add:
'
'Or strExt = ".XXX"
'
'Replace "XXX" with desired extension to be blocked/exlcuded.
'Else If strExt = ".mp3" Or strExt = ".wav" Or strExt = ".gif" Or strExt = ".MOV" Or strExt = ".WMV" Or strExt = ".WMA" Or strExt = ".AVI" Or strExt = ".FLV" Or strExt = ".exe" Then
If strExt = ".mp3" Or strExt = ".wav" Or strExt = ".gif" Or strExt = ".MOV" Or strExt = ".WMV" Or strExt = ".WMA" Or strExt = ".AVI" Or strExt = ".FLV" Or strExt = ".exe" Then
objExplorer2.Document.Body.InnerHTML = "File " & intFileCount & " of " & strCountTheFiles & " is being processed."
intFileCount = intFileCount + 1
ErrCheck
Else
'Build file path locations
objSource(1)=objFSO.BuildPath(RepSource,objFile.name)
ErrCheck
objDest=objFSO.BuildPath(RepDest,objFile.name)
ErrCheck
'These next lines will check if file already exists.
'If file exists, it will then further compare the source file
'with the destination file checking size and date modified difference.
If objFSO.FileExists(objDest) Then
Set objDestCompare=objFSO.GetFile(objDest)
ErrCheck
objExplorer2.Document.Body.InnerHTML = "File " & intFileCount & " of " & strCountTheFiles & " is being processed."
intFileCount = intFileCount + 1
ErrCheck
If objDestCompare.Size<>objFile.Size Or objDestCompare.DateLastModified<>objFile.DateLastModified Then
objFile.Copy objDest,True
ErrCheck
objExplorer2.Document.Body.InnerHTML = "File " & intFileCount & " of " & strCountTheFiles & " is being processed."
intFileCount = intFileCount + 1
ErrCheck
End If
Else
'If objFile.Attributes AND 2 = True Then
'Else If objFile.Attributes AND 4 = True Then
'Else
'copy - The heart of the script
objFile.Copy objDest,True
'End If
'End If
objExplorer2.Document.Body.InnerHTML = "File " & intFileCount & " of " & strCountTheFiles & " is being processed."
intFileCount = intFileCount + 1
ErrCheck
ErrCheck
'End If
'End If
End If
End If
Next
ErrCheck
'This For loop copies all subfolders from source to dest.
For each objFile in objSource(0).SubFolders
'If objFile.Attributes AND 2 Then
'Else If objFile.Attributes AND 4 Then
'********************************************************************
'* EXCLUDE FOLDERS
'********************************************************************
'Exclude folders - This next line will contain all folder names that are
'to be excluded when backing up files. Very important line. Also to add
'more extensions to be blocked - simply add:
'
'Or objFile = "XXXXX"
'
'Replace "XXXXX" with desired folder to be blocked/exlcuded.
'Else If objFile.Name = "My Music" Or objFile.Name = "My Videos" Or objFile.Name = "My Pictures" Then
If objFile.Name = "My Music" Or objFile.Name = "My Videos" Or objFile.Name = "My Pictures" Then
Else
objSource(1)=objFSO.BuildPath(RepSource,objFile.name)
ErrCheck
objDest=objFSO.BuildPath(RepDest,objFile.name)
ErrCheck
Backup objSource(1),objDest
ErrCheck
'End If
'End If
End If
Next
ErrCheck
'Clean up and release memory.
Set objSource(0) = Nothing
Set objSource(1) = Nothing
Set objDest = Nothing
Set objDestCompare = Nothing
End Sub
'********************************************************************
'*
'* Sub CleanMemory()
'* Purpose: Clean memory by freeing/releasing all script variables.
'* Input: None
'* Output: None
'* Notes: This sub will script variables.
'*
'********************************************************************
Sub CleanMemory
'Clean up and release memory.
Set objFSO = Nothing
Set objUsername = Nothing
Set objFolder = Nothing
Set objShell = Nothing
Set objWMIService(0) = Nothing
Set objItem = Nothing
Set objExplorer = Nothing
Set objFile = Nothing
Set strUsername = Nothing
Set strComputer = Nothing
Set strPath = Nothing
Set strFolder(0) = Nothing
Set strFolder(1) = Nothing
Set strFolder(2) = Nothing
Set strFolder(3) = Nothing
Set strFolder(4) = Nothing
Set intTime = Nothing
Set intHorizontal = Nothing
Set intVertical = Nothing
Set ColItems = Nothing
Set objFile = Nothing
Set strExt = Nothing
Set strExcludeFolder = Nothing
End Sub
Sub CreateShort
Dim objShellCS, objUsernameCS, objShortcutCS
Dim strFolderCS, strusernameCS
Set objShellCS = CreateObject("Wscript.Shell")
strFolderCS = objShellCS.SpecialFolders.Item("Desktop")
'This function finds the username of the user running this script.
Set objUsernameCS = createobject("WSCRIPT.Network")
strusernameCS = objUsernameCS.UserName
Set objShortcutCS = objShellCS.CreateShortcut(strFolderCS & "\" & strusernameCS & ".lnk")
objShortcutCS.TargetPath = "\\yonga720j3bt957\USERS\" & strusernameCS
objShortcutCS.IconLocation = "\\yonga720j3bt957\Tech Support\Software\Utility\Tech_Support_Only\All_Users\pagoda.ico"
objShortcutCS.Save
Set objShellCS = Nothing
Set objUsernameCS = Nothing
Set objShortcutCS = Nothing
Set strFolderCS = Nothing
Set strusernameCS = Nothing
End Sub
Function CountTheFiles
Dim strCount(6), objShell
Set objShell = CreateObject("Wscript.Shell")
strCount(1) = CountFiles (objShell.SpecialFolders.Item("Desktop"))
strCount(2) = CountFiles (objShell.SpecialFolders.Item("MyDocuments"))
strCount(3) = CountFiles (objShell.SpecialFolders.Item("Favorites"))
strCount(4) = CountFiles (objShell.SpecialFolders.Item("Startup"))
strCount(5) = CountFiles ("C:\Documents and Settings\john.key1\Local Settings\Application Data\Microsoft\Outlook")
strCount(6) = CountFiles ("C:\Documents and Settings\john.key1\Application Data\Microsoft\Outlook")
strCount(0) = strCount(1) + strCount(2) + strCount(3) + strCount(4) + strCount(5) + strCount(6)
CountTheFiles = strCount(0)
Set strCount(0) = Nothing
Set strCount(1) = Nothing
Set strCount(2) = Nothing
Set strCount(3) = Nothing
Set strCount(4) = Nothing
Set strCount(5) = Nothing
Set strCount(6) = Nothing
Set objShell = Nothing
End Function
Function CountFiles (ByVal strCountFolder)
Dim ParentFld
Dim SubFld
Dim IntCount
Dim fs
Set fs = CreateObject("scripting.filesystemobject")
Set ParentFld = fs.GetFolder (strCountFolder)
IntCount = ParentFld.Files.Count
For Each SubFld In ParentFld.SubFolders
IntCount = IntCount + CountFiles(SubFld.Path)
Next
CountFiles = IntCount
End Function
V/r,
SPC Key
United States Army
I have a script here that I am working on bit by bit...it is my largest script to date and frankly I want to know what everyone thinks and if improvements can be made to the coding? Either by rearranging, compacting, and/or a most effienct way to do the script?
How about it?
'***********************************************************************************
'*
'* File: BCKUP_FILES_957.VBS
'* Created: July 15, 2008
'* Created By: SPC Key, John E.
'* Last Modified: July 26, 2008
'* Version: 1.4
'*
'* Main Function: Backup user files to network share drive.
'*
'* Recommended Screen Resolution: 1280 X 1024
'*
'***********************************************************************************
On error resume next
LogIt("Backup script has started.")
'Set timeout for four (4) hours.
'If script runs longer than four hours,
'the script will be terminated automatically.
'The timeout is measured in seconds.
'14400 seconds equals 4 hours.
WScript.Timeout = 14400
'********************************************************************
'* Declare main variables
'********************************************************************
'Variables are sorted by type, and
'only one type of variable will apear on one line.
'For example, all object variables will be on same line,
'all string variables will be on same line, etc.
Dim objFSO, objUsername, objFolder, objShell, objWMIService(1), objItem, objExplorer, objFile
Dim objProcess, objWMI, objWQL, objResult, objInstance
' Increase "strFolder" array number if more folders are required to be backed up.
Dim strUsername, strComputer, strPath, strFolder(6), strExt, strExcludeFolder
Dim intTime, intHorizontal, intVertical, intFileCount
Dim ColItems, colProcessList
intFileCount = 1
'The current time is stored within the integer to provide an elapsed time at end of script.
intTime=Time
Set objFSO=wscript.CreateObject("Scripting.FileSystemObject")
'This function finds the username of the user running this script.
Set objUsername = createobject("WSCRIPT.Network")
strUsername = objUsername.UserName
'This function finds the directory paths of Windows special folders,
'then stores them in an array of "strFolder" for later use.
'Something neat about this feature is we do not have to search for
'where the users "My Documents" folder might be located. If it is located
'under C drive - no problem; if it is located under D, E, or F drive - no
'problem.
Set objShell = CreateObject("Wscript.Shell")
strFolder(0) = objShell.SpecialFolders.Item("Desktop")
strFolder(1) = objShell.SpecialFolders.Item("MyDocuments")
strFolder(2) = objShell.SpecialFolders.Item("Favorites")
strFolder(3) = objShell.SpecialFolders.Item("Startup")
strFolder(5) = "C:\Documents and Settings\" & strUsername & "\Local Settings\Application Data\Microsoft\Outlook"
strFolder(6) = "C:\Documents and Settings\" & strUsername & "\Application Data\Microsoft\Outlook"
strCountTheFiles = CountTheFiles
'Start error checking.
'On Error Resume Next
'Checking for user folder presence on share drive.
'This line will create user folder in the event of user folders absence.
If Not objFso.FolderExists("\\yonga720j3bt957\USERS\" & strUsername) Then objFso.CreateFolder("\\yonga720j3bt957\USERS\" & strUsername)
ErrCheck
CreateShort
ErrCheck
'The period within the quotes represents current computer this script is running on.
strComputer = "."
'These next lines of code will verify if Outlook is closed.
'If outlook is open, script will prompt notifying user to
'finish using Outlook and then press OK to close Outlook.
Set objWMIService(1) = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
ErrCheck
Set colProcessList = objWMIService(1).ExecQuery("Select * from Win32_Process")
ErrCheck
For Each objProcess in colProcessList
ErrCheck
If objProcess.Name = "OUTLOOK.EXE" then
Msgbox "Microsoft Outlooks was found running. Please save your files, " & _
"then press OK to close Outlook",48,"Outlook Needs to Close"
set objWMI = GetObject("winmgmts:")
objWQL = "select * from win32_process where name='outlook.exe'"
ErrCheck
set objResult = objWMI.ExecQuery(objWQL)
ErrCheck
for each objInstance in objResult
objInstance.Terminate(0)
ErrCheck
next
ErrCheck
End If
ErrCheck
Next
ErrCheck
'These next few lines get a feel for what display dimensions
'that this script is working with. These lines will be used
'to help place the iexplorer window correctly.
Set objWMIService(0) = GetObject("Winmgmts:\\" & strComputer & "\root\cimv2")
ErrCheck
Set colItems = objWMIService(0).ExecQuery("Select * From Win32_DesktopMonitor")
ErrCheck
For Each objItem in colItems
intHorizontal = objItem.ScreenWidth
intVertical = objItem.ScreenHeight
ErrCheck
Next
'These next four lines of code find the current
'directory that this script is running in. This
'function is is used to prevent errors when
'future(below) codelooks for a animated gif file.
'As long as the gifand this script are in same
'folder, there will beno error when displaying
'the animated image. This also assists in versatility
'when moving script to new users computer - it
'does not matter what folder the file needs to
'be inside.
strPath = Wscript.ScriptFullName
Set objFSO = CreateObject("Scripting.FileSystemObject")
ErrCheck
Set objFile = objFSO.GetFile(strPath)
ErrCheck
strFolder(4) = objFSO.GetParentFolderName(objFile)
'These lines of code excute iexplorer displaying a message and
'a animated gif notifying user that backup task will take several minutes.
Set objExplorer = CreateObject ("InternetExplorer.Application")
ErrCheck
With objExplorer
.Navigate "about:blank"
.ToolBar = 0
.StatusBar = 0
.Left = (intHorizontal - 400) / 2
.Top = (intVertical - 540) / 2
.Width = 330
.Height = 220
.Visible = 1
.Document.Body.Style.Cursor = "wait"
'These commented out lines are a second option for this script.
'If you want NO animated gif with script, use these lines instead.
'objExplorer.Document.Title = "Backup script in progress"
'objExplorer.Document.Body.InnerHTML = "Your backup script is being processed. " _
'& "This might take several minutes to complete."
.Document.Title = "Backup script in progress"
'.Document.Body.InnerHTML = "<img src='file:///" & strFolder(4) & "\progress.gif' height=75 width=75>" & _
.Document.Body.InnerHTML = "<img src='file:///\\yonga720j3bt957\Tech Support\Software\Utility\Tech_Support_Only\All_Users\progress.gif' height=75 width=75>" & _
"<br><br>Your backup is being processed.<br><br>" & _
"This might take several minutes to complete."
End With
Set objExplorer2 = CreateObject ("InternetExplorer.Application")
ErrCheck
With objExplorer2
.Navigate "about:blank"
.ToolBar = 0
.StatusBar = 0
.Left = (intHorizontal - 400) / 2
.Top = (intVertical - 100) / 2
.Width = 330
.Height = 80
.Visible = 1
.Document.Body.Style.Cursor = "wait"
.Document.Title = "File Count"
.Document.Body.InnerHTML = "File " & intFileCount & " of " & strCountTheFiles & " is being processed."
End With
'This a meaty part of the script calling upon the "Backup" sub.
'Format for adding more folders:
'Backup [source],[destination]
Backup strFolder(0),"\\yonga720j3bt957\USERS\" & strUsername & "\Desktop"
ErrCheck
Backup strFolder(1),"\\yonga720j3bt957\USERS\" & strUsername & "\My Documents"
ErrCheck
Backup strFolder(2),"\\yonga720j3bt957\USERS\" & strUsername & "\Favorites"
ErrCheck
Backup strFolder(3),"\\yonga720j3bt957\USERS\" & strUsername & "\Startup"
ErrCheck
Backup strFolder(5),"\\yonga720j3bt957\USERS\" & strUsername & "\Outlook - App Settings"
ErrCheck
Backup strFolder(6),"\\yonga720j3bt957\USERS\" & strUsername & "\Outlook - App Settings"
ErrCheck
'Once backup is complete, this section notifies user and quits IE.
With objExplorer
.Document.Body.InnerHTML = "Your backup is now complete."
.Document.Body.Style.Cursor = "default"
End With
objExplorer2.Quit
Wscript.Sleep 7000
objExplorer.Quit
LogIt("Backup script has finished.")
CleanMemory
'********************************************************************
'* End of Main Script
'********************************************************************
'********************************************************************
'*
'* Sub LogIt()
'* Purpose: Logs any text passed through this sub function.
'* Input: Text
'* Output: Log File
'* Notes: This sub will log events and date/time the occurance.
'*
'********************************************************************
Sub LogIt(strText)
Const ForAppending = 8
'Declair sub variables.
Dim strScriptPath, strDirectory, strFile, strLogUsername
Dim objFileSO, objLogFile, objLogFolder, objTextFile
'This function finds the username of the user running this script.
Set objUsername = createobject("WSCRIPT.Network")
strLogUsername = objUsername.UserName
'Find script name.
strScriptPath = Wscript.ScriptFullName
'Gather script fule file name and store into variable.
Set objFileSO = CreateObject("Scripting.FileSystemObject")
Set objLogFile = objFileSO.GetFile(strScriptPath)
strDirectory = objFileSO.GetParentFolderName(objLogFile)
'Create naming scheme for log file.
strFile = "\BCKUP - " & strLogUsername & ".log"
'Check if folder is created; otherwise, it will be created.
Set objFileSO = CreateObject("Scripting.FileSystemObject")
If objFileSO.FolderExists(strDirectory) Then
Set objLogFolder = objFileSO.GetFolder(strDirectory)
Else
Set objLogFolder = objFileSO.CreateFolder(strDirectory)
End If
'Check if file is created; otherwise, it will be created.
If objFileSO.FileExists(strDirectory & strFile) Then
Set objLogFolder = objFileSO.GetFolder(strDirectory)
Else
Set objLogFile = objFileSO.CreateTextFile(strDirectory & strFile)
End If
'Clean memory
Set objLogFile = Nothing
Set objLogFolder = Nothing
'Write to log file.
Set objTextFile = objFileSO.OpenTextFile(strDirectory & strFile, ForAppending, True)
objTextFile.WriteLine(Now & ": " & strText)
objTextFile.Close
'Clean memory
Set strDirectory = Nothing
Set strFile = Nothing
Set strLogUsername = Nothing
Set objFileSO = Nothing
Set objTextFile = Nothing
Set strScriptPath = Nothing
End Sub
'********************************************************************
'*
'* Sub ErrCheck()
'* Purpose: Check error level and deal with script accordingly.
'* Input: None
'* Output: None
'* Notes: This sub will notify user of error and create log of error.
'*
'********************************************************************
Sub ErrCheck
If Err.Number <> 0 Then
'Log error information to log file within same directory that script is running.
LogIt("There was an error." & vbCrLf & "Error Description: " & Err.Description & VbCrLf & "Error Number: " & Err.Number & VbCrLf & "Error Source: " & Err.Source)
'Grab a hold of IE and terminate.
objExplorer.Quit
Set objExplorer = Nothing
objExplorer2.Quit
Set objExplorer2 = Nothing
'This next line clears the error.
Err.Clear
'Stop the script when error occures.
CleanMemory
WScript.Quit
End If
End Sub
'********************************************************************
'*
'* Sub Backup()
'* Purpose: Backup user files from local computer to network folder that belongs to user.
'* Input: Source - Destination
'* Output: None
'* Notes: This sub will copy every file and folder under the directory passed to it to the network drive.
'*
'********************************************************************
Sub Backup(RepSource,RepDest)
On Error Resume Next
Dim objSource(1), objDest, objDestCompare
Set objSource(0)=objFSO.GetFolder(RepSource)
ErrCheck
'Check if destination folder exists; otherwise, create it.
If Not objFSO.FolderExists(RepDest) Then objFSO.CreateFolder(RepDest)
ErrCheck
'Begin processing each file under folder
For each objFile in objSource(0).Files
'This next line of code finds the extension of the file, and
'stores it in the variable. This is important becuase it works
'closely with the function we need to exclude certain files, like
'MP3, WAV, etc.
strExt = Right(objFile.Name,4)
ErrCheck
'These next two lines check if file is either a system file or hidden file.
'If the file is either one, the file will be ignored; therefore, not
'being copied. This check was added based on the fact that this script will
'attempt to copy everything with the folder - this posed a problem when it
'tried to copy a file that it did not have permissions too.
'If objFile.Attributes AND 2 Then
'Else If objFile.Attributes AND 4 Then
'********************************************************************
'* EXCLUDE FILE EXTENSIONS
'********************************************************************
'Exclude files - This next line will contain all file extensions that are
'to be excluded when backing up files. Very important line. Also to add
'more extensions to be blocked - simply add:
'
'Or strExt = ".XXX"
'
'Replace "XXX" with desired extension to be blocked/exlcuded.
'Else If strExt = ".mp3" Or strExt = ".wav" Or strExt = ".gif" Or strExt = ".MOV" Or strExt = ".WMV" Or strExt = ".WMA" Or strExt = ".AVI" Or strExt = ".FLV" Or strExt = ".exe" Then
If strExt = ".mp3" Or strExt = ".wav" Or strExt = ".gif" Or strExt = ".MOV" Or strExt = ".WMV" Or strExt = ".WMA" Or strExt = ".AVI" Or strExt = ".FLV" Or strExt = ".exe" Then
objExplorer2.Document.Body.InnerHTML = "File " & intFileCount & " of " & strCountTheFiles & " is being processed."
intFileCount = intFileCount + 1
ErrCheck
Else
'Build file path locations
objSource(1)=objFSO.BuildPath(RepSource,objFile.name)
ErrCheck
objDest=objFSO.BuildPath(RepDest,objFile.name)
ErrCheck
'These next lines will check if file already exists.
'If file exists, it will then further compare the source file
'with the destination file checking size and date modified difference.
If objFSO.FileExists(objDest) Then
Set objDestCompare=objFSO.GetFile(objDest)
ErrCheck
objExplorer2.Document.Body.InnerHTML = "File " & intFileCount & " of " & strCountTheFiles & " is being processed."
intFileCount = intFileCount + 1
ErrCheck
If objDestCompare.Size<>objFile.Size Or objDestCompare.DateLastModified<>objFile.DateLastModified Then
objFile.Copy objDest,True
ErrCheck
objExplorer2.Document.Body.InnerHTML = "File " & intFileCount & " of " & strCountTheFiles & " is being processed."
intFileCount = intFileCount + 1
ErrCheck
End If
Else
'If objFile.Attributes AND 2 = True Then
'Else If objFile.Attributes AND 4 = True Then
'Else
'copy - The heart of the script
objFile.Copy objDest,True
'End If
'End If
objExplorer2.Document.Body.InnerHTML = "File " & intFileCount & " of " & strCountTheFiles & " is being processed."
intFileCount = intFileCount + 1
ErrCheck
ErrCheck
'End If
'End If
End If
End If
Next
ErrCheck
'This For loop copies all subfolders from source to dest.
For each objFile in objSource(0).SubFolders
'If objFile.Attributes AND 2 Then
'Else If objFile.Attributes AND 4 Then
'********************************************************************
'* EXCLUDE FOLDERS
'********************************************************************
'Exclude folders - This next line will contain all folder names that are
'to be excluded when backing up files. Very important line. Also to add
'more extensions to be blocked - simply add:
'
'Or objFile = "XXXXX"
'
'Replace "XXXXX" with desired folder to be blocked/exlcuded.
'Else If objFile.Name = "My Music" Or objFile.Name = "My Videos" Or objFile.Name = "My Pictures" Then
If objFile.Name = "My Music" Or objFile.Name = "My Videos" Or objFile.Name = "My Pictures" Then
Else
objSource(1)=objFSO.BuildPath(RepSource,objFile.name)
ErrCheck
objDest=objFSO.BuildPath(RepDest,objFile.name)
ErrCheck
Backup objSource(1),objDest
ErrCheck
'End If
'End If
End If
Next
ErrCheck
'Clean up and release memory.
Set objSource(0) = Nothing
Set objSource(1) = Nothing
Set objDest = Nothing
Set objDestCompare = Nothing
End Sub
'********************************************************************
'*
'* Sub CleanMemory()
'* Purpose: Clean memory by freeing/releasing all script variables.
'* Input: None
'* Output: None
'* Notes: This sub will script variables.
'*
'********************************************************************
Sub CleanMemory
'Clean up and release memory.
Set objFSO = Nothing
Set objUsername = Nothing
Set objFolder = Nothing
Set objShell = Nothing
Set objWMIService(0) = Nothing
Set objItem = Nothing
Set objExplorer = Nothing
Set objFile = Nothing
Set strUsername = Nothing
Set strComputer = Nothing
Set strPath = Nothing
Set strFolder(0) = Nothing
Set strFolder(1) = Nothing
Set strFolder(2) = Nothing
Set strFolder(3) = Nothing
Set strFolder(4) = Nothing
Set intTime = Nothing
Set intHorizontal = Nothing
Set intVertical = Nothing
Set ColItems = Nothing
Set objFile = Nothing
Set strExt = Nothing
Set strExcludeFolder = Nothing
End Sub
Sub CreateShort
Dim objShellCS, objUsernameCS, objShortcutCS
Dim strFolderCS, strusernameCS
Set objShellCS = CreateObject("Wscript.Shell")
strFolderCS = objShellCS.SpecialFolders.Item("Desktop")
'This function finds the username of the user running this script.
Set objUsernameCS = createobject("WSCRIPT.Network")
strusernameCS = objUsernameCS.UserName
Set objShortcutCS = objShellCS.CreateShortcut(strFolderCS & "\" & strusernameCS & ".lnk")
objShortcutCS.TargetPath = "\\yonga720j3bt957\USERS\" & strusernameCS
objShortcutCS.IconLocation = "\\yonga720j3bt957\Tech Support\Software\Utility\Tech_Support_Only\All_Users\pagoda.ico"
objShortcutCS.Save
Set objShellCS = Nothing
Set objUsernameCS = Nothing
Set objShortcutCS = Nothing
Set strFolderCS = Nothing
Set strusernameCS = Nothing
End Sub
Function CountTheFiles
Dim strCount(6), objShell
Set objShell = CreateObject("Wscript.Shell")
strCount(1) = CountFiles (objShell.SpecialFolders.Item("Desktop"))
strCount(2) = CountFiles (objShell.SpecialFolders.Item("MyDocuments"))
strCount(3) = CountFiles (objShell.SpecialFolders.Item("Favorites"))
strCount(4) = CountFiles (objShell.SpecialFolders.Item("Startup"))
strCount(5) = CountFiles ("C:\Documents and Settings\john.key1\Local Settings\Application Data\Microsoft\Outlook")
strCount(6) = CountFiles ("C:\Documents and Settings\john.key1\Application Data\Microsoft\Outlook")
strCount(0) = strCount(1) + strCount(2) + strCount(3) + strCount(4) + strCount(5) + strCount(6)
CountTheFiles = strCount(0)
Set strCount(0) = Nothing
Set strCount(1) = Nothing
Set strCount(2) = Nothing
Set strCount(3) = Nothing
Set strCount(4) = Nothing
Set strCount(5) = Nothing
Set strCount(6) = Nothing
Set objShell = Nothing
End Function
Function CountFiles (ByVal strCountFolder)
Dim ParentFld
Dim SubFld
Dim IntCount
Dim fs
Set fs = CreateObject("scripting.filesystemobject")
Set ParentFld = fs.GetFolder (strCountFolder)
IntCount = ParentFld.Files.Count
For Each SubFld In ParentFld.SubFolders
IntCount = IntCount + CountFiles(SubFld.Path)
Next
CountFiles = IntCount
End Function
V/r,
SPC Key
United States Army
