SharePoint Backup Script

Here is a VB script I put together which performs a full SharePoint backup on a rolling 7 day weekly basis. Other benefits include email notifier which sends an email to the SharePoint administrator detailing whether the backup was successful or not.


' Email source address
Const strFrom = "sharepoint@contoso.com"

'Email destination address
Const strTo = "sharepointadmin@contoso.com"

' Mail server address
Const strMailserver = "mailserver.contoso.com"

' Create variable used to contain the name of day
Dim varWeekDay
varWeekDay = (WeekdayName(Weekday(date)))

Set objShell = CreateObject("WScript.Shell")

' Obtain the path where stsadm is located on the server
Dim strRegKey
strRegKey = objShell.RegRead ("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Shared Tools\Web Server Extensions\12.0\Location")

Dim strMOSSPath
strMOSSPath = strRegKey & "BIN\"

Dim strBackupLocation
strBackupLocation = "\\server\SharePointBackups\" & varWeekDay

' Define the path to SharePoint Backup Restore Table file which contains
' crucial information regarding the outcome of the backup
Dim SharPointBackupRestoreTable
SharPointBackupRestoreTable = strBackupLocation & "\spbrtoc.xml"


Call deleteBackupFolder (strBackupLocation)

'Ensure the script runs in the SharePoint directory
objShell.CurrentDirectory = strMOSSPath

' Execute stsadm backup command
objShell.Exec ("stsadm -o backup -directory " & strBackupLocation & " -backupmethod full")

' This Do loop checks the status of the backup process every minute.
' If the backup process hasn't completed within 60 minutes an email is sent to the
' Sharepoint administrator notifying him/her about this, otherwise an email is sent
' notifying the SharePoint Administrator of the outcome of the backup
Do
loopCounter = loopCounter + 1

If count > 60 Then
Call SendEmail("SharePoint Backup Process exceeded 60 minutes", "SharePoint backup process has been running for over 60 minutes.

Please check progress of backup")
End If

' Wait for 1 minute
WScript.Sleep 60000

' Check if the backup process (i.e. stsadm.exe) is currently running
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set sharepointProcess = objWMIService.ExecQuery ("Select * from Win32_Process Where Name = 'stsadm.exe'")

If (sharepointProcess.count) = 0 Then
' Backup process has ended therefore check the SharePoint Backup Restore Table to analyse the outcome of the backup
Set objXMLDoc = CreateObject("Microsoft.XMLDOM")
objXMLDoc.async = False
objXMLDoc.load(SharPointBackupRestoreTable)
Set NodeList = objXMLDoc.documentElement.selectNodes("//SPErrorCount")
For Each Node In NodeList
If (Node.text) <> "0" Then
' Backup errors were generated
Call SendEmail("SharePoint backup Failed", "SharePoint backup failed with errors. Please investigate backup logs")
Else
' No backup errors were generated
Call SendEmail("SharePoint backup successfully completed", "SharePoint backup completed without errors")
End If
Next

Exit Do
End If


Loop


'Sends email with status of backups
Sub SendEmail (subject, body)
Set objEmail = CreateObject("CDO.Message")
objEmail.From = strFrom
objEmail.To = strTo
objEmail.Subject = subject
objEmail.Textbody = body
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strMailserver
objEmail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objEmail.Configuration.Fields.Update
objEmail.Send
Call WriteEvent(subject,body)
End Sub

' Log the backup outcome to server application event log
Sub WriteEvent(subject,body)
If subject = "SharePoint backup successfully completed" Then
objShell.LogEvent 0, body
Else
objShell.LogEvent 1, body
end If
End Sub

Sub deleteBackupFolder (backupLocation)
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FolderExists(backupLocation)) Then
' Delete existing backup folder
fso.DeleteFolder(backupLocation)
' Create new backup folder
fso.createFolder(backupLocation)
Else
' Folder not present therefore create new folder
fso.createFolder(backupLocation)
End If
End Sub

Note: Remember to make sure you have enabled the WScript scripting engine. To do this simply execute the following VBScript commands:

Set ShellObject = WScript.CreateObject ("WScript.Shell")

ShellObject.RegWrite "HKEY_CLASSES_ROOT\VBSFile\Shell\Open\Command\", "%WINDIR%\System32\wScript.exe //nologo ""%1"" %*", "REG_EXPAND_SZ"
ShellObject.RegWrite "HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\Open\Command\", "%WINDIR%\System32\wScript.exe //nologo ""%1"" %*", "REG_EXPAND_SZ"