'========================================================================= ' 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: [email protected] ' WEB: https://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 protected]" '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 protected]" '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 protected]" '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 protected]" '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 protected]" '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 protected]" '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 protected]" '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
