Improved Generic Exchange Backup Script

So after numerous emails about this, and some comments on my previous blog post back in June, I spent a couple of hours this afternoon improving the backup script (which although was written as a generic Exchange backup script, is suitable for file system, system state and more - it just depends entirely what you set the selection criteria as). I've got it running now at home great, so it's worth sharing to the bigger audience now.

The biggest request I had was for email notification if an error occurs. Sending an email is simple (honestly). However, I didn't just want to send any old boring email, I wanted to utilise some of the more advanced features capable in Outlook, and show you how you can use the extended version of CDO for Exchange (CDOEx) rather than CDO. That having been said, to keep it generic and so that this script would run on any Windows Server, I ended up using CDO and SMTP rather than the more advanced capabilities of CDOEx. I've left the CDOEx code in there if you want to go that route, and I have tested it and it does work, so is a good example if you need it. The advanced features are so that the message flag is set to highlight some action is required. It is complicated due to timezone issues, but I think they're pretty well sust, so it should work all the way from Seattle to Sydney.

Here's an example of what I mean by "advanced" - notice that the email is red, and flagged with a follow-up action

Here's the revised script. I have a question though for someone really techy which I just can't find the answer to. I'll post a followup entry shortly. Cut/Paste and save as backup.vbs. Generate your Windows Backup selection file as before, and change the series of constants at the top of the file according to your needs - recipients for error emails, SMTP servers etc. Note that I haven't tested anything except anonymous SMTP drop.

' ************************************************************************************
' * Weekly Backup Script for Exchange
' * John Howard, Microsoft UK. Created 25th June 2005
' * History:
' * 04 Nov 2005 - Added Email Sending on Failure (see inline comments)
' *
' * Feel free to use/modify for your own needs.
' * No guarantees though although it works for me :-)
' * However, if you can do better, contact me through https://blogs.technet.com/jhoward
' ************************************************************************************

Option Explicit
On error resume next
Const NO_ERROR = 0
Const BACKUP_PROGRAM = "c:windowssystem32ntbackup.exe "
Const cdoImportance = "urn:schemas:httpmail:importance"
Const cdoHigh = 2 ' Importance
Const cdoAnonymous = 0
Const cdoBasic = 1
Const cdoNTLM = 2
Dim SMTP_AUTH

' TAILOR THESE NEXT CONSTANTS TO YOUR REQUIREMENTS
Const DEFAULT_SENDER = "Backup Job <servername@contoso.com>"
Const DEFAULT_RECIP = "user@contoso.com"
Const DEFAULT_SUBJECT = "Backup Failure on Exchange!"
Const SMTP_SERVER = "exchange.contoso.com"
Const SMTP_PORT = 25
SMTP_AUTH = cdoAnonymous ' Choose one of the above
Const SMTP_TIMEOUT = 60 ' Seconds to wait for SMTP Server
Const MESSAGE_FLAG = "URGENT: Backup Job has failed"
Const BACKUP_SHARE = "\RemoteServerExchangeBackups"
Const BACKUP_SELECTION = "Exchange Backup Selection.bks"

Dim szYYWW ' Date in YYYY-WW format (Week of year)
Dim szYYMMDD ' Date in YYYY-MM-DD format
Dim szFlagsSelection ' The backup selection script, prepopulated
Dim szSetDescription ' The description of the backup set
Dim szDestinationFile ' The destination file in the destination directory
Dim szFlagsJobName ' Flags for the name of the job [/j "jobname")
Dim szFlagsVerify ' Flags for verify the backup [yes|no]
Dim szFlagsRemoteStorage ' Flags for remote storage [/rs:no|yes]
Dim szFlagsHardwareCompress ' Flags for hardware compression [/hc:off|on]
Dim szFlagsLogging ' Flags for logging in ntbackup [/l:f|s|n] Full SUmmary None
Dim szFlagsAppend ' Flags for appending data [/a] or nothing
Dim szFlagsRestrict ' Flags for restricting access [/r:yes|no]
Dim szFlagsType ' Flags for backup type [/m normal|Incremental|Differential...]
Dim szFlagsTapeName ' Flags for name of tape
Dim oFSO ' File System Object to see if file already exists
Dim owShell ' To execute a shell command
Dim rc ' Return code
Dim szError ' If we have an error, record it in here
Dim szCommandLine ' What we are going to run as a backup
Dim szUTC ' UTC Date/Time for SMTP Reply-By field

Set oFSO = Nothing
set owShell = Nothing
rc = NO_ERROR ' OK So far
szCommandLine = "" ' Not sure what we're running yet
szError = "" ' Not had an error yet

' Setup our variables
if (NO_ERROR = rc) Then
szYYWW = year(now()) & " w" & formatNumber(DatePart("WW",now()))
szYYMMDD = year(now()) & "-" & formatNumber(month(now())) & "-" & formatNumber(day(now()))
szFlagsSelection = chr(34) & "@" & BACKUP_SHARE & "" & BACKUP_SELECTION & chr(34)
szFlagsJobName = "/j " & chr(34) & "Exchange Backup" & chr(34)
szFlagsVerify = "/v:yes" ' Verify YES|NO
szFlagsRemoteStorage = "/rs:no"
szFlagsHardwareCompress = "/hc:off" ' Hardware compression off - this is to disk
szFlagsLogging = "/l:f" ' f=full s=summary n=none
szFlagsAppend = "/a" ' /a for Append or leave blank to overwrite
szFlagsRestrict = "/r:no" ' no|yes Restrict access to administrators
szFlagsTapeName = "/t:Exchange " & szYYWW
szDestinationFile = "Exchange " & szYYWW & ".bkf"
szSetDescription = "/d " & chr(34) & "Created " & szYYMMDD & chr(34)
szUTC = GetUTCSMTPDateString()
end if

' Instantiate File System Object
if (NO_ERROR = rc) Then
err.clear
Set oFSO = CreateObject("Scripting.FileSystemObject")
if (err.number) or (oFSO is nothing) Then
rc = -1
szError = "Failed Creating FSO: " & err.description & " -0x" & hex(err.number)
end if
end if

' Look to see if the file exists to determine the backup type
if (NO_ERROR = rc) Then
if not oFSO.FileExists(BACKUP_SHARE & "" & szDestinationFile) then
' Normal | Copy | Differential | Incremental Backup Type
szFlagsType = "/m normal "
szFlagsAppend = "" ' Don't Append if does not exist
else
' File exists, so incremental backup. We are already in Append mode
szFlagsType = "/m incremental "
szSetDescription = "/d " & chr(34) & "Inc " & szYYMMDD & chr(34)
end if

' Release File SYstem Object
set oFSO = Nothing
end if

' Create a Shell Object to be able to run the backup executable
if (NO_ERROR = rc) Then
err.clear
Set owShell = wscript.createobject("wscript.shell")
if (err.number) or (owShell is nothing) Then
rc = -2
szError = "Failed Creating wscript.shell: " & err.description & " -0x" & hex(err.number)
end if
end if

' Build the backup command and run it
if (NO_ERROR = rc) Then
szCommandLine = BACKUP_PROGRAM & _
"backup" & " " & _
szFlagsSelection & " " & _
szSetDescription & " " & _
"/f " & chr(34) & BACKUP_SHARE & "" & szDestinationFile & chr(34) & " " & _
szFlagsAppend & " " & _
szFlagsLogging & " " & _
szFlagsVerify & " " & _
szFlagsRestrict & " " & _
szFlagsRemoteStorage & " " & _
szFlagsHardwareCompress & " " & _
szFlagsType & " " & _
szFlagsJobName & " "

rc=owshell.run(szCommandLine,,True)
end if

set owShell = Nothing
if (rc) Then SendErrorEmail
wscript.quit(rc)

Function FormatNumber(szIn)
FormatNumber = szIn
if len(szIn) = 1 then FormatNumber = "0" & szIn
End Function

'-----------------------------------------------------------------------------------
' Function Added: JJH 04 Nov 2005
'-----------------------------------------------------------------------------------
' For Sending an Email. We have the option to use send using exchange, but
' this can only be done on the Exchange server itself and requires CDOEx which
' is only installed on an Exchange Server. However CDO (CDOSys in old speak) is
' also installed on any Windows 2003 Server, and is a subset of CDOEx, we can
' use SMTP to send from any server pointing towards our Exchange Server.
' HOWEVER: It is nice to be able to get a reminder in Outlook to say that
' we need to do something rather than just an email. This requires an additional
' message header Reply-By which is in the Format (eg) Fri, 4 Nov 2005 15:23:08 -0000.
' Now, rather than mess around with timezones etc, I just use UTC. Seems to work,
' but it probably also helps that I'm in the UK so don't have to worry too much
' about timezones generally :-) However, appreciate many people may use this
' who are outside of UK, so best to make an effort!
'
' Note: We also fail safe to assume no time bias if we can't read registry
'-----------------------------------------------------------------------------------
Function GetUTCSMTPDateString()
Dim dtUTC ' UTC Date
Dim szUTC ' UTC Date string in SMTP RFC Format
Dim oShell ' To read registry
Dim szATBRegKey ' Registry key for Active Time Bias
Dim lMinutesOffset ' From UTC
Dim rc ' Function return

On error resume next
rc = 0
szATBRegKey = "HKEY_LOCAL_MACHINESystemCurrentControlSetControlTimeZoneInformationActiveTimeBias"
lMinutesOffset = 0
err.clear

if (NO_ERROR = rc) Then
err.clear
set oShell = CreateObject("WScript.Shell")
if (err.number) or (oShell = Nothing) Then rc = -1
end if

if (NO_ERROR = rc) Then
lMinutesOffset = oShell.RegRead(szATBRegKey)
if (err.number) then
rc = -1
lMinutesOffset = 0
end if
end if

' Regardless of error, we do the formatting (default to zero offset)
dtUTC = dateadd("n", lMinutesOffset, now())
szUTC = WeekdayName(Weekday(dtUTC),True) & ", " & _
Day(dtUTC) & " " & _
MonthName(Month(dtUTC),True) & " " & _
Year(dtUTC) & " " & _
FormatNumber(Hour(dtUTC)) & ":" & _
FormatNumber(Minute(dtUTC)) & ":" & _
FormatNumber(Second(dtUTC)) & " " & _
"-0000"

set oShell = Nothing
err.clear ' Don't pass any error back as we will have _something_
GetUTCSMTPDateString = szUTC

End Function

'-----------------------------------------------------------------------------------
' Function Added: JJH 04 Nov 2005
'-----------------------------------------------------------------------------------
' There are several solutions to sending email. We _could_ use CDOEx, but we need
' to be running on an Exchange Server to do this. While you might say "But this is
' a generic Exchange backup program, so of course it's running on an Exchange Server",
' remember although I built it for Exchange backups, it's still pretty generic and
' can be used for file system backups or system state etc.
'
' CDOEx is not "remoteable" - it can only be instantiated on the Exchange Server
' itself. Hence, not very generic.
'
' BUT - CDOEx has advantages. You can use "SendUsingExchange" rather than SMTP
' which allows you to relatively easily set a reminder on the message itself.
' You would unfortunately also be limited to not just running on an Exchange
' Server, but who you are sending it _from_ must have their mailbox on that
' local server.
'
' Plan B: Use CDO which is present on all Windows Servers. However, to do this
' has its own problems if you also want the message to flag up if you're using
' a rich Outlook client to read the message.
'
' Plan B and a half is to incorporate elements of both solution (see inline comments,
' with some code commented out) but using SMTP.
'
' Note: I could have done this, but it just would have been _too_ easy :-)
'
'Dim oMsg
'set oMsg = CreateObject("CDO.Message")
'oMsg.To = "user@contoso.com"
'oMsg.From = "Exchange@contoso.com"
'oMsg.Subject = "Backup Status"
'oMsg.TextBody = "Whatever you want"
'oMsg.Send
'set oMsg = Nothing

'-----------------------------------------------------------------------------------
Function SendErrorEmail()

Dim oMsg ' Message we send if failure occurs
Dim szFrom ' String
Dim szBaseFolder ' Base folder for the current users mailbox
Dim rc

szFrom = ""
rc = NO_ERROR
set oMsg = Nothing

' COMMENTED OUT - COULD USE IF WE KNOW THIS IS RUNNING ON AN EXCHANGE SERVER
' REASON BEING: CDO.Person and IMailbox Interface are only implemented in CDOEx, not CDO
' Following block is to generate a full from email address so that we
' use a better display name if we are sending the email externally from
' the Exchange organisation. Not strictly necessary, but nicer.
' Also, no error checking implemented
' Dim IMailbox ' Mailbox Interface to CDO.Person object
' Dim oADSInfo ' ActiveDS.ADSystemInfo
' Dim oPerson ' CDO.Person
' set oADSInfo = CreateObject("ADSystemInfo")
' set oPerson = CreateObject("CDO.Person")
' oPerson.DataSource.Open("LDAP://" & oADSInfo.DomainDNSName & "/" & oADSInfo.UserName)
' szFrom = oPerson.FileAs ' May be blank if no description in AD
' if 0 = len(szFrom) then szFrom = "Exchange Backup Script"
' szFrom = szFrom & " <" & oPerson.Email & ">"

' Need to have a default sender
if (NO_ERROR = rc) Then
if 0 = len(szFrom) Then szFrom = DEFAULT_SENDER
end if

' COMMENTED OUT - AGAIN CDOEX SPECIFIC. Assuming we use code block commented
' above, we need to make sure that the users mailbox we are sending FROM (which
' is the currently logged on user) is homed on the current Exchange Server.
' The base folder will be something like file://./backofficestorage/<domain>/MBX/<User>/
' set IMailbox = oPerson.GetInterface("IMailbox")
' szBaseFolder = IMailbox.BaseFolder
' if (0=len(szBaseFolder)) Then <TRAP ERROR HERE>

' Create a message object. Not a lot we can do if we can't - could put further
' checking maybe to write to event log. Exercise for the reader though.
if (NO_ERROR = rc) Then
err.clear
set oMsg = CreateObject("CDO.Message")
if (err.number) or (oMsg is nothing) Then rc = -1
end if

' Configure the outbound email
if (NO_ERROR = rc) Then

With oMsg.Configuration
'.Fields(cdoSaveSentItems) = False

' CDOEX Specific next line
'.Fields("https://schemas.microsoft.com/cdo/configuration/sendusing") = cdoSendUsingExchange

' SMTP Specific lines instead of above commented out line
.Fields("https://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ' SMTP By Port
.Fields("https://schemas.microsoft.com/cdo/configuration/smtpserver") = SMTP_SERVER
.Fields("https://schemas.microsoft.com/cdo/configuration/smtpserverport") = SMTP_PORT
.Fields("https://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = SMTP_AUTH
.Fields("https://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = SMTP_TIMEOUT
' If using BASIC, need to set cdo/configuration/sendusername and sendpassword accordingly

' Update fields from the configuration
.Fields.Update
end With

oMsg.To = DEFAULT_RECIP
oMsg.From = szFrom
oMsg.Subject = DEFAULT_SUBJECT

oMsg.TextBody = "Backup Job has failed" & vbcrlf
oMsg.TextBody = oMsg.TextBody & "Error: " & szError & vbcrlf & vbcrlf
oMsg.TextBody = oMsg.TextBody & "Backup Job: " & szCommandLine

' CDOEX/SendUsingExchange Specific to set the message flag
'oMsg.Fields("https://schemas.microsoft.com/mapi/proptag/0x10900003")=2
'oMsg.Fields("urn:schemas:httpmail:messageflag")= MESSAGE_FLAG

' SMTP Way of doing this
oMsg.Fields("urn:schemas:mailheader:Reply-By") = szUTC
oMsg.Fields("urn:schemas:mailheader:X-Message-Flag") = MESSAGE_FLAG

oMsg.Fields(cdoImportance) = cdoHigh
oMsg.Fields.Update
oMsg.Send
end if

set oMsg = Nothing

' If using CDOEx
'set oPerson = Nothing
'set oADSInfo = Nothing

End Function

Someone smart may wonder what's oMsg.Fields("https://schemas.microsoft.com/mapi/proptag/0x10900003")=2 about. If you want to know, and how I went about finding out, it's a long story. Post a comment and I'll put up the details when I get a spare day (it's that long). <GRIPE>Previous to working at Microsoft, obtaining info like this was my day job - I had plenty of support cases lined up at MS and got pretty up tight about some of the decisions made by the Exchange Dev team, and specifically those working on the SDK tools. Seems like even since my gripes a few years ago, the same lack of documentation (or deliberate hiding of this info more specifically is still there)</GRIPE>

 (Nov 2008) Updated as I discovered the formatting of the above script was awful in the new blog template. Also adding a link to a direct download of the script (save as a .vbs file rather than .txt). It's here.