Category Archives: Computers

Jan 22

ComputerInventory.vbs

Posted on by 
'=========================================================================
' ComputerInventory.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/21/2013
' COMPATIBLE: Windows XP+, Server 2003+. If you are using on Windows 2003,
'  to get correct CPU Physical and Core Counts make sure you have the following
'  hotfix installed: http://support.microsoft.com/kb/932370
' COMMENTS: Loops through a line delineated list of servers and reports back
'  the Manufacturer, Model #, Serial #, Windows OS, OS Architecture (32vs64),
'  RAM(MB), CPU Description, CPU Speed(GHz), CPU Physical Count, CPU Core Count,
'  Local Volumes with Total and Used Space in GB.
'  Edit the configuration to point to a text file containing the names of
'  the computers to inventory. By default, it will search the same directory
'  of the script, otherwise you can provide the full path. Also, set the max
'  number of Disk Volumes you want to return. By default, this is set to 5 but,
'  you may need to increase this number if your computers use a lot of volumes.
' EXAMPLE: Inventory Servers.txt in the Current Directory with a max of 5 volumes
'  Dim computerList: computerList = "servers.txt"
'  Dim maxVolumes: maxVolumes = 5
' EXAMPLE: Inventory Servers.txt using a full path with a max of 8 volumes
'  Dim computerList: computerList = "C:\servers.txt"
'  Dim maxVolumes: maxVolumes = 8
'=========================================================================
Option Explicit
' ------ SCRIPT CONFIGURATION ------
Dim computerList: computerList = "servers.txt"
Dim maxVolumes: maxVolumes = 5
' ------ END CONFIGURATION ------

'Ensure Computer List Exists
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
If Not objFSO.FileExists(computerList) Then
    Wscript.Echo "ERROR - Input File Does Not Exist!" & vbCrLf & vbCrLf & "Quitting Script!"
    Wscript.Quit
End If

'Create Log File
Dim strLogFile: strLogFile = Replace(Wscript.ScriptName, ".vbs", ".txt")
Dim strHeadings: strHeadings = "COMPUTER" & vbTab & _
    "MAKE" & vbTab & _
    "MODEL" & vbTab & _
    "SERIAL" & vbTab & _
    "OS" & vbTab & _
    "ARCHITECTURE" & vbTab & _
    "RAM(MB)" & vbTab & _
    "CPU" & vbTab & _
    "SPEED(GHz)" & vbTab & _
    "PHYSICAL" & vbTab & _
    "CORE"
Dim i
Dim strVolumes: strVolumes = ""
If maxVolumes > 0 Then
    For i = 1 to maxVolumes
        strVolumes = strVolumes & vbTab & "HDD(Used/Total)"
    Next
Else
    'Default to Single Volume If an Invalid # Was Assigned
    maxVolumes = 1
End If
strHeadings = strHeadings & strVolumes
Call Logger(strLogFile, strHeadings, True)

'Get Server Info
Const ForReading = 1
Dim objTextFile: Set objTextFile = objFSO.OpenTextFile(computerList, ForReading)
Dim strComp, strManufacturer, strModel, strSerial, strOS, strOSArchitecture, strRAM, strProcessor, strVolume, strTemp
Do Until objTextFile.AtEndOfStream
    strComp = Trim(objTextFile.Readline)
    If strComp <> "" Then
        If ServerUpTime(strComp) = "!~ERROR~!" Then
            strTemp = strComp & "(Offline)" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & vbTab & _
                "!~ERROR~!" & Replace(strVolumes, "HDD(Used/Total)", "!~ERROR~!")
            Call Logger(strLogFile, strTemp, False)
        Else   
            strManufacturer = GetManufacturer(strComp)
            strModel = GetModel(strComp)
            strSerial = GetSerial(strComp)
            strOS = GetOS(strComp)
            strOSArchitecture = GetOSArchitecture(strComp)
            strRAM = GetRAM(strComp)
            strProcessor = GetProcessor(strComp)
            strVolume = GetVolume(strComp, maxVolumes)
            Call Logger(strLogFile, strComp & vbTab & strManufacturer & vbTab & strModel & vbTab & strSerial & vbTab & strOS & vbTab & strOSArchitecture & vbTab & strRAM & vbTab & strProcessor & vbTab & strVolume, False)
        End If
    End If
Loop           
Wscript.Echo "Finished"

Private Function ServerUpTime(strComputer)

    On Error Resume Next

    Dim objWMISettings: Set objWMISettings = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMISettings.ExecQuery("Select * from Win32_OperatingSystem")
    Dim strResult
    Dim objItem, dtmBootup, dtmLastBootupTime, dtmSystemUptime
    For Each objItem in colItems
        dtmBootup = objItem.LastBootUpTime
        dtmLastBootupTime = CDate(Mid(dtmBootup, 5, 2) & "/" & Mid(dtmBootup, 7, 2) & "/" & Left(dtmBootup, 4) & " " & Mid (dtmBootup, 9, 2) & ":" & Mid(dtmBootup, 11, 2) & ":" & Mid(dtmBootup, 13, 2))
        dtmSystemUptime = DateDiff("h", dtmLastBootUpTime, Now)
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    Else
        strResult = dtmSystemUptime
    End If 
    ServerUpTime = strResult

    'Kill Objects
    Set objWMISettings = Nothing

    On Error GoTo 0  ' End Error Handling

End Function

Private Function GetManufacturer(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
    Dim strResult
    Dim objItem
    For Each objItem in colItems
        strResult = Trim(objItem.Manufacturer)
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If
    GetManufacturer = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetModel(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
    Dim strResult
    Dim objItem
    For Each objItem in colItems
        strResult = Trim(objItem.Model)
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If
    GetModel = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetSerial(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_BIOS")
    Dim strResult
    Dim objItem
    For Each objItem in colItems
        strResult = Trim(objItem.SerialNumber)
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If
    GetSerial = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetOS(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
    Dim strResult
    Dim objItem
    For Each objItem in colItems
        strResult = Trim(objItem.Caption)
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If
    GetOS = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetOSArchitecture(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate,authenticationLevel=Pkt}!\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Processor")
    Dim strResult
    Dim objItem
    For Each objItem In colItems
        Select Case objItem.Architecture
            Case 0
                strResult = "32-bit"
            Case 9
                strResult = "64-bit"           
        End Select
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If 
    GetOSArchitecture = strResult

    'Kill Ovjects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetRAM(strComputer)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_ComputerSystem")
    Dim strResult
    Dim objItem
    For Each objItem in colItems
        strResult = Round(objItem.TotalPhysicalMemory/1024/1024,0)
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "!~ERROR~!"
    End If 
    GetRAM = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetProcessor(strComputer)

    'If Using Server 2003 Install the Following Hotfix to Get Correct Physical and Core CPU Counts
    'http://support.microsoft.com/kb/932370

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Processor")
    Dim strResult
    Dim objItem
    Dim strCPU: strCPU = ""
    Dim strSpeed: strSpeed = ""
    Dim intPhysical: intPhysical = 0
    Dim intCores: intCores = 0
    For Each objItem in colItems
        strCPU = objItem.Description
        strSpeed = Round(objItem.CurrentClockSpeed/1000,2)
        intPhysical = colItems.Count
        intCores = objItem.NumberOfCores
    Next

    'Return Results
    If Err.Number <> 0 Then
        Err.clear
        strResult = "!~ERROR~!" & vbTab & "!~ERROR~!" & vbTab & "!~ERROR~!" & vbTab & "!~ERROR~!"
    Else
        strResult = strCPU & vbTab & strSpeed & vbTab & intPhysical & vbTab & intCores
    End If     
    GetProcessor = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

Private Function GetVolume(strComputer, maxVolCount)

    On Error Resume Next

    Dim objWMIService: Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType='3'")
    Dim strResult: strResult = ""
    Dim objItem, totalSpace, usedSpace
    Dim i: i = 0
    For Each objItem in colItems
        totalSpace = FormatNumber(objItem.Size/1024/1024/1024)
        usedSpace = FormatNumber((objItem.Size - objItem.FreeSpace)/1024/1024/1024)
        i = i + 1
        If i = 1 Then
            strResult = objItem.DeviceID & "(" & usedSpace & "/" & totalSpace & ")"
        Elseif i > maxVolCount Then
            'Skip
        Else
            strResult = strResult & vbTab & objItem.DeviceID & "(" & usedSpace & "/" & totalSpace & ")"
        End If
    Next
    If colItems.Count < maxVolCount Then
        For i = 1 to maxVolCount - colItems.Count
            strResult = strResult & vbTab & "N/A"
        Next
    End If

    'Return Results
    If Err.Number <> 0 Then
        Err.Clear
        If maxVolCount > 0 Then
            For i = 1 to maxVolCount
                If i = 1 Then
                    strResult = "!~ERROR~!"
                Else
                    strResult = strResult & vbTab & "!~ERROR~!"
                End If
            Next
        Else
            strResult = "!~ERROR~!"
        End If
    End If 
    GetVolume = strResult

    'Kill Objects
    Set objWMIService = Nothing

    On Error Goto 0

End Function

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

 

Jan 01

GetIPInfo.vbs

Posted on by 
'=========================================================================
' GetIPInfo.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Input a Computer DNS/IP, which then Clears the Current Arp Cache,
' Gets the IP of the DNS/IP, and then gets the MAC address of the DNS/IP.
' EXAMPLE: Wscript.Echo GetIPInfo("Computer")
'=========================================================================
Option Explicit
Wscript.Echo GetIPInfo("Computer")

Private Function GetIPInfo(strComputerOrIP)

    On Error Resume Next

    Dim strResult: strResult = ""
    Call ClearARP()
    ' Get IP of Host Name
    Dim strIP: strIP = GetIP(strComputerOrIP)
    ' Get MAC of Host Name
    Dim strArp: strArp = GetMAC(strIP)

    GetIPInfo = strComputerOrIP & vbTab & strIP & vbTab & strArp

    On Error Goto 0

End Function

' **************************************************************************************************
' Sub ClearARP - Clears the ARP Cache
' **************************************************************************************************
Private Sub ClearARP()

        On Error Resume Next

        ' Clear ARP Cache
       Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
        objShell.Run("netsh interface ip delete arpcache")

        ' Kill Objects
        Set objShell = Nothing

        On Error Goto 0

End Sub

' **************************************************************************************************
' Function GetIP - Returns an IP From Passing an Host Name or IP Into the Function
' ********************************************************************
Private Function GetIP(strHost)

    On Error Resume Next

    ' Ping Host and Extract IP Address
    Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
    Dim objPing: Set objPing = objShell.Exec("%comspec% /c For /f " & chr(34) & "tokens=2 delims=[]" & chr(34) & " %A In ('Ping -a -n 1 " & strHost & "') Do %A")
    Dim strPingResults: strPingResults = objPing.StdOut.ReadAll

    ' Search For an IP Address from Results
    Dim RegEx: Set RegEx = New RegExp
    RegEx.IgnoreCase = True
    RegEx.Global = True
    RegEx.Pattern = "[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}"
    If Regex.Test(strPingResults) = True then
        Dim Matches: Set Matches = RegEx.Execute(strPingResults)
        Dim strMatch
        For Each strMatch in Matches
            ' Return Result
            GetIP = strMatch
        Next
    Else
        GetIP = "!~ERROR~!"
    End If

    ' Kill Objects
    Set objShell = Nothing

    On Error Goto 0

End Function

' **************************************************************************************************
' Function GetMAC - Returns a MAC Address From Passing an IP Into the Function
' ********************************************************************
Private Function GetMAC(strIP)

        On Error Resume Next

        ' Check ARP Table and Results
        Dim objShell: Set objShell = WScript.CreateObject("WScript.Shell")
        Dim objArp: Set objArp = objShell.Exec("arp -a " & strIP)
        Dim strArpResult: strArpResult = objArp.StdOut.ReadAll

        ' Search For a MAC Address from Results
       Dim RegEx: Set RegEx = New RegExp
        RegEx.IgnoreCase = True
        RegEx.Global = True
        RegEx.Pattern = "[0-9A-F]{2}-[0-9A-F]{2}-[0-9A-F]{2}-[0-9A-F]{2}-[0-9A-F]{2}-[0-9A-F]{2}"
        If Regex.Test(strArpResult) = True then
                Dim Matches: Set Matches = RegEx.Execute(strArpResult)
                Dim strMatch
                For Each strMatch in Matches
                    GetMAC = strMatch
                Next
        Else
            GetMAC = "!~ERROR~!"
        End if

        ' Kill Objects
        Set objShell = Nothing

        On Error Goto 0

End Function

 

Jan 01

ListLoggedOnUsers.vbs

Posted on by 
'=========================================================================
' ListLoggedOnUsers.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 1/1/2011
' COMMENTS: Pass a Computer Name or IP to the Function and it will return
' the name computer name, # logged on users, and username of the logged on
' users. This works for local, remote, and RDP sessions.
' EXAMPLE: Wscript.Echo ListCurrentLoggedOn("computer")
' Wscript.Echo ListCurrentLoggedOn("192.168.1.100")
'=========================================================================
Option Explicit
Wscript.Echo ListLoggedOnUsers("computer")

Private Function ListLoggedOnUsers(strComputer)

    On Error Resume Next

    ' Determine Logged On Users By Owner of Explorer.exe Process
    Dim objWMIService: Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
    Dim colProcess: Set colProcess = objWMIService.ExecQuery("Select * from Win32_Process Where Name='explorer.exe'")
    Dim objProcess, colProperties, strUser, strDomain, strResult
    If colProcess.Count = 0 Then
        strResult = "Computer:" & strComputer & vbTab & "Count:" & colProcess.Count & vbTab & "User:N/A"
    Else
        Dim i: i = 1
        For Each objProcess in colProcess
            colProperties = objProcess.GetOwner(strUser,strDomain)
            strResult = strResult & "Computer:" & strComputer & vbTab & "Count:" & i & vbTab & "User:" & strDomain & "\" & strUser & vbCrLf
            i = i + 1
        Next
    End If

    'Check For Errors
    If Err.Number <> 0 Then
        Err.Clear
        strResult = "Computer:" & strComputer & vbTab & "Count:!~ERROR~!" & vbTab & "User:!~ERROR~!"
    End If

    'Cleanup
    Set objWMIService = Nothing
    Set colProcess = Nothing

    'Return Result
    ListLoggedOnUsers = strResult

    On Error Goto 0

End Function

 

Jan 01

NTBackup.vbs

Posted on by 
'=========================================================================
' 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