NTBackup.vbs

'=========================================================================
' NTBackup.vbs
' VERSION: 2.2 - Modified backupDestination to auto include the backupTitle as the end directory
' 2.1 - Fixed potential error on blat attachments
' 2.0 - Complete rewrite
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 3/7/2013
' REQUIREMENTS:
' - NTBackup.exe 2000, XP, 2003
' - A .bks file of directories to back up (Note: Best to Selct in NTBackup and Save Selection)
' - blat.exe, blat.dll. blat.lib in the same directory as the script (http://www.blat.net)
' - Blat profile installed to email results
' - Recommended to use Stunnel to Encrypt Email Sessions, Especially If the Email Server
' is not on your subnet ex: Gmail
' COMMENTS:
' Version 2.0 is a complete rewrite and I suggest you switch to this if using an earlier
' version. It corrects some small issues, improves deployment, and simplifies usage.
' The script is designed to automate backups with the task schedular, and email
' results using blat. It is capable of backing up local or remote files as long as the
' account it is running under has the appropriate permissions. It is designed to retain
' backups using weekly retention schedules and I would suggest a minimum of 2 weeks
' which leaves you with a weeks worth of backups while the other overwrites.
' Assuming you use 2 weeks of backups starting on Friday January 7, 2011
' you would need the following copies of this script and scheduled tasks.
'
' EXAMPLE WEEK1: Server_Full1.vbs, Server_Inc01.vbs, Server_IncA1.vbs
' Fri - Server_Full1.vbs 9:00PM, run every other week, starting Jan 7, 2011
'         ------ SCRIPT CONFIGURATION ------
'       Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
'       Dim backupType: backupType = "Full" 'Full, Inc
'       Dim backupOverwrite: backupOverwrite = True 'Overwrite Incremental Backup
'       Dim backupWeek: backupWeek = 1 'Modify to match the backup week (Ex: 1, 2...etc)
'       Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
'       Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
'       Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
'       Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
'         ------ END CONFIGURATION ------
' Mon - Server_IncO1.vbs 9:00PM, run every other week, starting Jan 10, 2011
'         ------ SCRIPT CONFIGURATION ------
'       Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
'       Dim backupType: backupType = "Inc" 'Full, Inc
'       Dim backupOverwrite: backupOverwrite = True 'Overwrite Incremental Backup
'       Dim backupWeek: backupWeek = 1 'Modify to match the backup week (Ex: 1, 2...etc)
'       Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
'       Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
'       Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
'       Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
'         ------ END CONFIGURATION ------
' Tue, Wed, Thu - Server_IncA1.vbs 9:00PM, run every other week, starting Jan 11, 2011
'         ------ SCRIPT CONFIGURATION ------
'       Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
'       Dim backupType: backupType = "Inc" 'Full, Inc
'       Dim backupOverwrite: backupOverwrite = False 'Overwrite Incremental Backup
'       Dim backupWeek: backupWeek = 1 'Modify to match the backup week (Ex: 1, 2...etc)
'       Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
'       Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
'       Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
'       Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
'         ------ END CONFIGURATION ------
'
' EXAMPLE WEEK2: Server_Full2.vbs, Server_Inc02.vbs, Server_IncA2.vbs
' Fri - Server_Full2.vbs 9:00PM, run every other week, starting Jan 14, 2011
'         ------ SCRIPT CONFIGURATION ------
'       Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
'       Dim backupType: backupType = "Full" 'Full, Inc
'       Dim backupOverwrite: backupOverwrite = True 'Overwrite Incremental Backup
'       Dim backupWeek: backupWeek = 2 'Modify to match the backup week (Ex: 1, 2...etc)
'       Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
'       Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
'       Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
'       Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
'         ------ END CONFIGURATION ------
' Mon - Server_IncO2.vbs 9:00PM, run every other week, starting Jan 17, 2011
'         ------ SCRIPT CONFIGURATION ------
'       Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
'       Dim backupType: backupType = "Inc" 'Full, Inc
'       Dim backupOverwrite: backupOverwrite = True 'Overwrite Incremental Backup
'       Dim backupWeek: backupWeek = 2 'Modify to match the backup week (Ex: 1, 2...etc)
'       Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
'       Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
'       Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
'       Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
'         ------ END CONFIGURATION ------
' Tue, Wed, Thu - Server_IncA2.vbs 9:00PM, run every other week, starting Jan 18, 2011
'         ------ SCRIPT CONFIGURATION ------
'       Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
'       Dim backupType: backupType = "Inc" 'Full, Inc
'       Dim backupOverwrite: backupOverwrite = False 'Overwrite Incremental Backup
'       Dim backupWeek: backupWeek = 2 'Modify to match the backup week (Ex: 1, 2...etc)
'       Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
'       Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
'       Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
'       Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
'         ------ END CONFIGURATION ------
'
' EXAMPLE .BKS FILE: Server.bks
' D:\Shares\Users\
' \\server\share\
'=========================================================================
Option Explicit
On Error Resume Next

' ------ SCRIPT CONFIGURATION ------
Dim backupTitle: backupTitle = "SERVERNAME" 'Name of the Server to Backup
Dim backupType: backupType = "Full" 'Full, Inc
Dim backupOverwrite: backupOverwrite = True 'Overwrite Incremental Backup
Dim backupWeek: backupWeek = 1 'Modify to match the backup week (Ex: 1, 2...etc)
Dim backupDestination: backupDestination = "E:\Backups\" 'Local Drive(E:\Backups\) or Network Drive (\\server\share\)
Dim emailBlatExe: emailBlatExe = "" 'Custom Path to Blat.exe Default is Same Folder as Script
Dim emailProfile: emailProfile = "ALERT" 'Blat Profile Name See (http://www.blat.net) For Info
Dim emailRecipient: emailRecipient = "EMAIL@DOMAIN.COM" 'Email to Receive Backup Result
' ------ END CONFIGURATION ------

'Create Log File
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "[ " & WScript.ScriptName & " ] " & vbCrLf & Now(), True)

' Create Objects
Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))

'Set NT Backup Global Variables
Dim ntBackupLogDir: ntBackupLogDir = objShell.ExpandEnvironmentStrings("%USERPROFILE%\Local Settings\Application Data\Microsoft\Windows NT\NTBackup\data\")
Dim bksFile: bksFile = scriptPath & backupTitle & ".bks"
Dim backupName: backupName = backupTitle & "_" & backupType & backupWeek
If Mid(backupDestination,Len(backupDestination),1) <> "\" Then
    backupDestination = backupDestination & "\"
End If
backupDestination = backupDestination & backupTitle
If Mid(backupDestination,Len(backupDestination),1) <> "\" Then
    backupDestination = backupDestination & "\"
End If
Dim bkfFile: bkfFile = backupDestination & backupName & ".bkf"
Dim ntBackupExe: ntBackupExe = objShell.ExpandEnvironmentStrings("%SYSTEMROOT%\system32\ntbackup.exe")

'Log Variables
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Variables ]", False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "backupTitle = " & backupTitle, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "backupType = " & backupType, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "backupOverwrite = " & backupOverwrite, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "backupWeek = " & backupWeek, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "backupDestination = " & backupDestination, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "emailProfile = " & emailProfile, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "emailRecipient = " & emailRecipient, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "ntBackupLogDir = " & ntBackupLogDir, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "bksFile = " & bksFile, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "backupName = " & backupName, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "bkfFile = " & bkfFile, False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "ntBackupExe = " & ntBackupExe, False)

'Verify Before Continuing
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Verify NTBackup.exe ]", False)
Call VerifyFileOrDir(ntBackupExe, False, False, Replace(WScript.ScriptFullName,".vbs",".log"))

Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Verify NT Backup Log Directory ]", False)
Call VerifyFileOrDir(ntBackupLogDir, True, False, Replace(WScript.ScriptFullName,".vbs",".log"))

Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Verify NT Backup Selection File (.bks) ]", False)
Call VerifyFileOrDir(bksFile, True, True, Replace(WScript.ScriptFullName,".vbs",".log"))

Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Verify NT Backup Destination Directory ]", False)
Call VerifyFileOrDir(backupDestination, True, True, Replace(WScript.ScriptFullName,".vbs",".log"))

'Get Backup Selections
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ NT Backup Selections ]", False)
Dim ntBackupSelection: ntBackupSelection = GetBackupSelection(bksFile)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), ntBackupSelection, False)

'Run NT Backup
Dim startTime: startTime = Now()
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ NT Backup ]", False)
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "Start Time: " & startTime, False)
Call RunNTBackup(backupType, backupOverwrite, ntBackupExe, bksFile, backupName, bkfFile, Replace(WScript.ScriptFullName,".vbs",".log"))
Dim endTime: endTime = Now()
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "End Time: " & endTime, False)

'Get NT Backup Results
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ NT Backup Results ]", False)
Dim ntBackupResult: ntBackupResult = GetNTBackupResult(".", startTime, endTime, Replace(WScript.ScriptFullName,".vbs",".log"))
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), "Returned Result = " & ntBackupResult, False)

'Find NT Backup Log File
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Find NT Backup Log File ]", False)
Dim ntBackupLogFile: ntBackupLogFile = GetNTBackupLog(ntBackupLogDir, startTime, endTime, Replace(WScript.ScriptFullName,".vbs",".log"))

'Set Blat Email Variables and Email Results
Call Logger(Replace(WScript.ScriptFullName,".vbs",".log"), vbCrLf & "[ Email Results ]", False)
Dim emailSubject: emailSubject = "NTBackup " & backupTitle & " - " & ntBackupResult
Dim emailBody: emailBody = backupName & " - " & ntBackupResult & " Backing up:" & "|" & ntBackupSelection
emailBody = ReplaceLineBreaks(emailBody)
Call SendBlatEmail(emailBlatExe, emailProfile, emailRecipient, emailSubject, emailBody, ntBackupLogFile, Replace(WScript.ScriptFullName,".vbs",".log"))

'Finish Script
Set objShell = Nothing

Private Sub VerifyFileOrDir(strPath, blnCreate, blnUnicode, strLog)

    On Error Resume Next

    Dim objFile
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    If objFSO.DriveExists(objFSO.GetDriveName(strPath)) Then
        If StrComp(objFSO.GetExtensionName(strPath), "", 1) = 0 Then
            If Not objFSO.FolderExists(strPath) Then
                If objFSO.FolderExists(objFSO.GetParentFolderName(strPath)) Then
                    If blnCreate = True Then
                        objFSO.CreateFolder strPath 'Create Folder In Current Path
                        'LOG CREATING FOLDER
                        If Err.Number <> 0 Then
                            Err.Clear
                            Call Logger(strLog, "Err Creating: " & strPath, False)
                            Call Logger(strLog, "Verification Failed - Quitting Script!", False)
                            Wscript.Quit
                        Else
                            Call Logger(strLog, "Created: " & strPath, False)
                        End If
                    Else
                        Call Logger(strLog, "Verification Failed, Folder Doesn't Exist - Quitting Script!", False)
                        Wscript.Quit
                    End If
                Else
                    VerifyFileOrDir objFSO.GetParentFolderName(strPath), blnCreate, blnUnicode, strLog 'Recurse Creating Parent Folder
                   VerifyFileOrDir strPath, blnCreate, blnUnicode, strLog 'Recurse Creating Current Folder
               End If
            Else
                'LOG FOLDER EXISTS
                Call Logger(strLog, "Exists: " & strPath, False)
            End If
        Else
            If Not objFSO.FileExists(strPath) Then
                If objFSO.FolderExists(objFSO.GetParentFolderName(strPath)) Then
                    If blnCreate = True Then
                        'Create File In Current Path
                        If blnUnicode = True Then
                            Set objFile = objFSO.CreateTextFile(strPath, True, True)
                            If StrComp(objFSO.GetExtensionName(strPath), "bks", 1) = 0 Then
                                'Default New Selection File to SystemState
                                objFile.Write "SystemState"
                                objFile.Close
                            End If
                            Set objFile = Nothing
                        Else
                            objFSO.CreateTextFile strPath, True
                        End If
                        'LOG CREATING FILE
                        If Err.Number <> 0 Then
                            Err.Clear
                            Call Logger(strLog, "Err Creating: " & strPath, False)
                            Call Logger(strLog, "Verification Failed - Quitting Script!", False)
                            Wscript.Quit
                        Else
                            Call Logger(strLog, "Created: " & strPath, False)
                        End If
                    Else
                        Call Logger(strLog, "Verification Failed, File Doesn't Exist - Quitting Script!", False)
                        Wscript.Quit
                    End If
                Else
                    VerifyFileOrDir objFSO.GetParentFolderName(strPath), blnCreate, blnUnicode, strLog  'Recurse Creating Parent Folder
                   VerifyFileOrDir strPath, blnCreate, blnUnicode, strLog  'Recurse Creating Current Folder
               End If
            Else
                'LOG FILE EXISTS
                Call Logger(strLog, "Exists: " & strPath, False)
            End If
        End If
    Else
        Call Logger(strLog, "Verification Failed, Drive Doesn't Exist - Quitting Script!", False)
        Wscript.Quit
    End If

    On Error Goto 0

End Sub

Private Function GetBackupSelection(strFile)

    On Error Resume Next

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objTextFile: Set objTextFile = objFSO.OpenTextFile(strFile, 1, False, -1)
    Dim strResult: strResult = objTextFile.ReadAll
    objTextFile.Close

    If Err.Number <> 0 Then
        Err.Clear
        strResult = "Error Reading Selection (.bks) File!"
    Else
        If strResult = "" OR IsNull(strResult) Then
            strResult = "Error Backup Selection (.bks) File is Blank!"
        End If
    End If

    GetBackupSelection = strResult

    On Error Goto 0

End Function

Private Sub RunNTBackup(strBackupType, blnBackupOverwrite, strNtBackupExe, strBksFile, strBackupName, strBkfFile, strLog)

    On Error Resume Next

    'Create Objects and Variables
    Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
    Dim runCommand

    'Set NT Backup Command 
    If StrComp(strBackupType,"Full",1) = 0 Then
        ' Full Backup Overwrite
        runCommand = strNtBackupExe & " backup " & chr(34) & "@" & strBksFile & chr(34) & " /n " & chr(34) & strBackupName & ".bkf created " & Now() & chr(34) & " /d " & chr(34) & "Set created " & Now() & chr(34) & " /v:yes /r:no /rs:no /hc:off /m normal /j " & chr(34) & strBackupName & chr(34) & " /l:s /f " & chr(34) & strBkfFile & chr(34)
    Elseif StrComp(strBackupType,"Inc",1) = 0 Then
        If blnBackupOverwrite = True Then
            'Incremental Backup Overwrite
            runCommand = strNtBackupExe & " backup " & chr(34) & "@" & strBksFile & chr(34) & " /n " & chr(34) & strBackupName & ".bkf created " & Now() & chr(34) & " /d " & chr(34) & "Set created " & Now() & chr(34) & " /v:yes /r:no /rs:no /hc:off /m incremental /j " & chr(34) & strBackupName & chr(34) & " /l:s /f " & chr(34) & strBkfFile & chr(34)
        Elseif blnBackupOverwrite = False Then
            'Incremental Backup Append
            runCommand = strNtBackupExe & " backup " & chr(34) & "@" & strBksFile & chr(34) & " /a /d " & chr(34) & strBackupName & ".bkf created " & Now() & chr(34) & " /v:yes /r:no /rs:no /hc:off /m incremental /j " & chr(34) & strBackupName & chr(34) & " /l:s /f " & chr(34) & strBkfFile & chr(34)
        Else
            Call Logger(strLog, "Error 'backupOverwrite' variable is not Set to True Or False - Aborting Script!", False)
            Wscript.Quit
        End If
    Else
        Call Logger(strLog, "Error 'backupType' variable is not Set to Full Or Inc - Aborting Script!", False)
        Wscript.Quit
    End If

    'Run NT Backup
    Call Logger(strLog, runCommand, False)
    objShell.Run runCommand, 1, True

    If Err.Number <> 0 Then
        Err.Clear
        Call Logger(strLog, "Error Occurred During NT Backup", False)
    End If

    On Error Goto 0

End Sub

Private Function GetNTBackupResult(strComputer, strStart, strEnd, strLog)

    On Error Goto 0

    'Get Job Status's From Event Viewer (Logs Event 8001 For Each Folder Completed in .bks file)
    'All Jobs logged to Most Recent Log in Default User Profile NTBackup Folder
    Dim objWMIService: Set objWMIService = GetObject("winmgmts:{(Security)}\\" & strComputer & "\root\cimv2")
    Dim colEvents: Set colEvents = objWMIService.ExecQuery("Select * from Win32_NTLogEvent Where Logfile = 'Application' AND EventCode = '8001'")
    Dim objEvent, strRecordDate, strResult: strResult = ""
    Call Logger(strLog, colEvents.Count & " NT Backup Logs Found Wherre EventCode = 8001", False)
    For Each objEvent in colEvents
        strRecordDate = WMIDateStringToDate(objEvent.TimeWritten)
        If DateDiff("S", startTime, strRecordDate) >= 0 AND DateDiff("S", endTime, strRecordDate) <= 0 Then
            Call Logger(strLog, "Time Written: " & strRecordDate & vbCrLf & objEvent.Message, False)
            If InStr(1, objEvent.Message, "error") > 1 Then
                'Error
                If strResult = "" OR null Then
                    strResult = "Error"
                End If
                If StrComp(strResult, "Success", 1) = 0 Then
                    strResult = "Error"
                End If
                If StrComp(strResult, "Warning", 1) = 0 Then
                    strResult = "Error"
                End If
                If StrComp(strResult, "Unknown", 1) = 0 Then
                    strResult = "Error"
                End If
            Elseif InStr(1,objEvent.Message,"warning",1) > 0 Then
                'Warning
                If strResult = "" OR null Then
                    strResult = "Warning"
                End If
                If StrComp(strResult, "Success", 1) = 0 Then
                    strResult = "Warning"
                End If
                If StrComp(strResult, "Unknown", 1) = 0 Then
                    strResult = "Warning"
                End If
            Elseif InStr(1,objEvent.Message,"successfully",1) > 0 Then
                'Success
                If strResult = "" OR null Then
                    strResult = "Success"
                End If
            Else
                'Uknown
                If strResult = "" OR null Then
                    strResult = "Unknown"
                End If
                If StrComp(strResult, "Success", 1) = 0 Then
                    strResult = "Unknown"
                End If
            End If
        End If
    Next

    'Set Return Value
    If strResult = "" or null Then
        strResult = "Unknown"
        Call Logger(strLog, "No Log Files Found Between " & strStart & " to " & strEnd, False)
    End If

    If Err.Number <> 0 Then
        Err.Clear
        strResult = "ERROR"
        Call Logger(strLog, "Error Detected Getting NT Backup Results", False)
    End If

    GetNTBackupResult = strResult

    On Error Goto 0

End Function

' Function Conver WMI Date to String Date
Function WMIDateStringToDate(dtmBootup)
    WMIDateStringToDate = CDate(Mid(dtmBootup, 5, 2) & "/" & _
    Mid(dtmBootup, 7, 2) & "/" & Left(dtmBootup, 4) _
    & " " & Mid (dtmBootup, 9, 2) & ":" & _
    Mid(dtmBootup, 11, 2) & ":" & Mid(dtmBootup, _
    13, 2))
End Function

Private Function GetNTBackupLog(strDir, strStart, strEnd, strLog)

    On Error Resume Next

    'Find Log File with the Latest Time Stamp
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim strResult: strResult = ""
    Dim file, nfile
    Dim objFolder: Set objFolder = objFSO.GetFolder(strDir)
    For Each file In objFolder.Files
        If Right(file.Name, 4) = ".log" Then
            If nfile = "" or nfile = null Then
                Set nfile = file
                strResult = nfile.Path
                Call Logger(strLog, "Original Latest Log: " & nfile.Name & " (" & nfile.DateLastModified & ")", False)
            Else
                If nfile.DateLastModified < file.DateLastModified Then
                    Set nfile = file
                    strResult = nfile.Path
                    Call Logger(strLog, "Later Log: " & nfile.Name & " (" & nfile.DateLastModified & ")", False)
                End If
            End If
        End If
    Next

    If strResult = "" Then     
        Call Logger(strLog, "Error No Log Files Found!", False)
    Else
        Call Logger(strLog, "Latest Log: " & strResult, False)
    End If

    If Err.Number <> 0 Then
        Err.Clear
        Call Logger(strLog, "Error Occured Getting NT Backup Log File!", False)
        strResult = ""
    End If

    GetNTBackupLog = strResult

    On Error Goto 0

End Function

Private Function ReplaceLineBreaks(myStr)

    On Error Resume Next

    myStr = Replace(myStr, vbCrLf, "|")

    ReplaceLineBreaks = myStr

    On Error Goto 0

End Function

Private Sub SendBlatEmail(blatPath, blatProfile, strRecipients, strSubject, strBody, strAttachment, strLog)

    'Need blat.exe, blat.dll, blat.lib
    On Error Resume Next

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))

    'Ensure Blat Exists
    If Not objFSO.FileExists(blatPath) Then
        Call Logger(strLog, "Provided Blat.exe Location Not Found: " & blatPath, False)
        Call Logger(strLog, "Attempt to Locate Blat.exe in Current Directory: " & scriptPath, False)
        If Not objFSO.FileExists(scriptPath & "blat.exe") Then
            Call Logger(strLog, "Default Blat.exe Location Not Found: " & scriptPath & "blat.exe", False)
            Exit Sub
        Else
            blatPath = scriptPath & "blat.exe"
            Call Logger(strLog, "Default Blat.exe Location Found: " & blatPath, False)
        End If
    Else
        Call Logger(strLog, "Provided Blat.exe Location Found: " & scriptPath & "blat.exe", False)
    End If

    'Set Blat Email Command
    Dim commandText: commandText = chr(34) & blatPath & chr(34)
    commandText = commandText & " -p " & chr(34) & blatProfile & chr(34)
    commandText = commandText & " -to " & strRecipients
    commandText = commandText & " -subject " & chr(34) & strSubject & " " & chr(34) 'Keep Space to Prevent Escaping the Quote
    commandText = commandText & " -body " & chr(34) & strBody & " " & chr(34) 'Keep Space to Prevent Escaping the Quote

    'Append Attachment(s)
    If objFSO.FileExists(strAttachment) Then
        commandText = commandText & " -attach " & chr(34) & strAttachment & "," & strLog & chr(34)
        Call Logger(strLog, "Provided Attachment Found: " & strAttachment, False)
    Else
        Call Logger(strLog, "Provided Attachment Not Found: " & strAttachment, False)
        Call Logger(strLog, "Attempt to Locate Attachment in Current Directory: " & scriptPath, False)
        If objFSO.FileExists(scriptPath & strAttachment) Then
            commandText = commandText & " -attach " & chr(34) & scriptPath & strAttachment & "," & strLog & chr(34)
            Call Logger(strLog, "Default Attachment Found: " & scriptPath & strAttachment, False)
        Else
            Call Logger(strLog, "Default Attachment Not Found: " & scriptPath & strAttachment, False)
            commandText = commandText & " -attach " & chr(34) & strLog & chr(34)
        End If
    End If

    'Send Blat Email
    Call Logger(strLog, "Email Results: " & commandText, False)
    objShell.run commandText, True

    Set objFSO = Nothing
    Set objShell = Nothing

    If Err.Number <> 0 Then
        Err.Clear
        Call Logger(strLog, "Error Occurred Emailing Results!", False)
    End If

    On Error Goto 0

End Sub

Private Sub Logger(fileName, logMessage, blnNewLog)

    On Error Resume Next

    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
    Dim logName
    If InStr(1,fileName,"\",1) > 0 Then
        logName = fileName
        If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then
            If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then
                If Not objFSO.FolderExists(logName) Then
                    If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        objFSO.CreateFolder logName 'Create Folder In Current Path
                        Exit Sub
                    Else
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder
                        Exit Sub
                    End If
                End If
            Else
                If Not objFSO.FileExists(logName) Then
                    If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog)  'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog)  'Recurse Creating Current Folder
                    End If
                End If
            End If
        End If
    Else
        logName = scriptPath & fileName
    End If
    Dim logFile
    If blnNewLog = True Then
        Set logFile = objFSO.CreateTextFile(logName, True)
    Else
        If objFSO.FileExists(logName) Then
            Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)
        Else
            Set logFile = objFSO.CreateTextFile(logName, True)
        End If
    End If
    logFile.WriteLine logMessage
    logFile.Close
    Set objFSO = Nothing

    On Error Goto 0

End Sub

 

Leave a Reply

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