Script-Based SharePoint 2007/2010 Site-Collection Backup - Part 1: The Script

This is the first article in a series of three that describe a script-based method for creating backups at the site-collection level.

• Script-Based SharePoint 2007/2010 Site-Collection Backup - Part 1: The Script
• Script-Based SharePoint 2007/2010 Site-Collection Backup - Part 2: Task Scheduling
• Script-Based SharePoint 2007/2010 Site-Collection Backup - Part 3: Notifications

With every new release of SharePoint I ask my Microsoft contacts if anything has changed in the area of backup management. The response is typically along the lines of "We have done some great things in this area and feel that our partners will be able to leverage these changes in their solutions." This means that we either have to make do with what we've got or shell out for a third party solution (which is not entirely unreasonable).

Hopefully you are doing backups of some sort. At the very least SQL Server database backups. But sometimes you might want something a little more granular. And if, for whatever reason, an investment in a commercial backup solution has not been made, you might want to consider some sort of automated script.

If that describes you, then the following may be of interest. Several years ago I put together a VBScript that will create backups for every site-collection in a web application, create an HTML log of the results which are then emailed or saved locally. Every time the script is run, the target share will be cleaned up so new backup files can be created. The assumption is that you have file system backups that can get these files to tape or disk for longer term storage.

Part 1 of this series of articles supplies you with that script and an example command line. Follow-up articles will come shortly where I will show you how I have used it in my own environments.

From a command prompt on one of the servers in your farm you would execute the script with the following options:

CScript BackupSiteCollections.vbs <Web Application> backuppath=<File Share UNC> from=<Email Address> notify=<Email Address> binpath=<Path To SharePoint BIN Folder> smtpserver=<Server Name, FQDN or IP Address>

So something a little more "real world" would look like this:

CScript BackupSiteCollections.vbs http://my.company.com backuppath=\\server\share from=admin@my.company.com notify=me@my.company.com binpath="C:\Program Files\Common Files\Microsoft Shared\Web Server Extensions\14\BIN" smtpserver=smtp.company.com

And here is the script itself:

'================================================
' BackupSiteCollections.vbs
'------------------------------------------------
' For the automated backup of MOSS 2007/2010 site
' collections.  Includes emailed backup report 
' and resource utilization.
'================================================

Option Explicit
On Error Resume Next

Dim strErrorMessage, objShell, intShellExecStatus

strErrorMessage = ""
Set objShell = CreateObject("WScript.Shell")

Dim strLogFolder
strLogFolder = objShell.SpecialFolders("MyDocuments") & "\Site-Collection Backup Logs"

'======================================================
' Parameters and Defaults
'======================================================

Dim strBinPath, strBackupPath, strBaseURL, strNotification, strFromAddress, strSmtpServer

strBinPath      = ""
strBackupPath   = ".\"
strURL          = ""
strNotification = ""
strFromAddress  = ""
strSmtpServer   = ""

'======================================================
' Read Arguments
'======================================================

Dim objArguments
Set objArguments = WScript.Arguments

If Err.Number > 0 Then
  strErrorMessage = strErrorMessage & FormatErrorMessage( Err.Number, Err.Description & " [receiving arguments]")
  Err.Clear
End If

Dim intArgCount
intArgCount = objArguments.Count

Dim intCounter, strThisArgument, strThisOption, strThisValue

For intCounter = 0 to intArgCount - 1
  
  strThisArgument = LCase( objArguments( intCounter ) )
  
  If inStr( strThisArgument, "=" ) > 0 Then
    strThisOption = Trim(Left( strThisArgument, InStr( strThisArgument, "=" ) - 1 ))
    strThisValue = Trim(Mid( strThisArgument, InStr( strThisArgument, "=" ) + 1 ))
  Else
    strThisValue = Trim(strThisArgument)
  End If
  
  Select Case strThisOption
  Case "notify"
    strNotification = strThisValue
  Case "from"
    strFromAddress = strThisValue
  Case "baseurl"
    strBaseUrl = strThisValue
  Case "backuppath"
    strBackupPath = strThisValue
    If Right(strBackupPath,1) <> "\" Then
      strBackupPath = strBackupPath & "\"
    End If
  Case "binpath"
    strBinPath = strThisValue
  Case "smtpserver"
    strSmtpServer = strThisValue
  Case Else
    strBaseUrl = strThisValue
  End Select

Next

'======================================================
' Begins building response to be sent as an e-mail.
' Note that it's being formatted as HTML.
'======================================================

Dim datStart, strReportHeader, strReportBody, strReportFooter

datStart        = Now()
strReportHeader = ""
strReportBody   = ""
strReportFooter = ""

strReportHeader = "<!DOCTYPE HTML PUBLIC""-//IETF//DTD HTML//EN"">" & vbCrLf & _
  "<html><head>" & vbCrLf & _
  "<title>Site Collection Backup Report</title>" & vbCrLf & _
  "<style type=""text/css"">" & vbCrLf & _
    "  body {background-color:#ffffff;font-family:Arial;font-size:12px;}" & vbCrLf & _
    "  table {width:100%;border-collapse:collapse;margin:0;}" & vbCrLf & _
    "  td {padding:0;font-size:12px;}" & vbCrLf & _
    "  td.status {font-family:Consolas,Courier New;border:1px #c0c0c0 solid;background-color:#eee;color:#888;padding:5px;}" & vbCrLf & _
    "  .error {border:1px #800 solid;background-color:#ff0;color:#800;padding:4px;font-weight:bolder;}" & vbCrLf & _
    "  .log {border:1px #888 solid;}" & vbCrLf & _
    "  .log th {border:1px #888 solid;background-color:#888;font-weight:bolder;padding:4px;}" & vbCrLf & _
    "  .log td {border:1px #888 solid;font-size:10px;padding:4px;}" & vbCrLf & _
  "</style>" & vbCrLf & _
  "</head><body>"

strReportHeader = strReportHeader & "<h1>Site-Collection Backup</h1>" & vbCrLf & _
  "<table><tr><td class=""status"">" & vbCrLf & _
  "  <div>Starting Task at <em>" & CStr( datStart ) & "</em></div>" & vbCrLf & _
  "  <hr>" & vbCrLf & _
  "  <div>Base URL......: <em>" & strBaseURL & "</em></div>" & vbCrLf & _
  "  <div>Backup Path ..: <em>" & strBackupPath & "</em></div>" & vbCrLf & _
  "  <div>BIN path......: <em>" & strBinPath & "</em></div>" & vbCrLf & _
  "</td></tr><tr><td>" 

'================================================

Dim strBaseCommandLine

strBaseCommandLine = ""
If Trim(strBinPath) <> "" Then
  strBaseCommandLine = strBaseCommandLine & Trim(strBinPath)
  If Right(strBaseCommandLine,1) <> "\" Then
    strBaseCommandLine = strBaseCommandLine & "\"
  End If
End If
strBaseCommandLine = strBaseCommandLine & "stsadm.exe"

Dim objFileSystem, objFolder, objFiles, objFile, objExec, strResult, objXml, objSiteCollection, objURL, strURL, strFileName, strCommandLine

Set objFileSystem = CreateObject("Scripting.FileSystemObject")

WScript.Echo vbCrLf & "|==> Retrieving site collection list..."
WScript.Echo strBaseCommandLine & " -o enumsites -url " & strBaseURL
Set objExec = objShell.Exec(strBaseCommandLine & " -o enumsites -url " & strBaseURL)
Do While objExec.Status
  WScript.Sleep 250
Loop
strResult = objExec.StdOut.ReadAll
WScript.Echo strResult

If InStr( 1, LCase(strResult), "</sites>") = 0 Then
  strErrorMessage = strErrorMessage & "Unable to retrieve list of site collections from " & strBaseUrl
Else
  Set objFolder = objFileSystem.GetFolder(strBackupPath)
  Set objFiles = objFolder.Files

  WScript.Echo vbCrLf & "|==> Deleting old backup files..."
  For Each objFile in objFiles
    If LCase(Right(objFile.Name,9)) = ".scbackup" Then
      objFile.Delete(True)
      If Err.Number > 0 Then
        strErrorMessage = strErrorMessage & FormatErrorMessage( Err.Number, "[Cleanup] " & Err.Description & " [deleting old backup files]")
        Err.Clear
      End If
    End If
  Next

  WScript.Echo vbCrLf & "|==> Loading XML..."
  Set objXml = CreateObject("MSXML2.DOMDocument")
  objXml.LoadXML(strResult)

  WScript.Echo vbCrLf & "|==> Processing XML..."

  Dim datBackupStartTime
  
  strReportBody = strReportBody & "<table class=""log""><tr><th>Site</th><th>Size<sup>1</sup></th><th>Owner</th><th>Database</th><th>Time<sup>2</sup></th><th>Result</th></tr>" & vbCrLf 
  
  For Each objSiteCollection in objXml.DocumentElement.ChildNodes

      strUrl = objSiteCollection.Attributes.GetNamedItem("Url").Text
      strFileName = strBackupPath & Replace(Replace(Replace(Replace(strUrl, "http://", ""),"https://",""), "/", "_"),":", "-") & ".scbackup"
      strCommandLine = strBaseCommandLine & " -o backup -url """ + strUrl + """ -filename """ + strFileName + """"
      WScript.Echo vbCrLf & "|==> Backing up site collection " & strUrl 

      strReportBody = strReportBody & "<tr><td><a href=""" & strUrl & """>" & strUrl & "</a></td><td align=""right"">" & FormatNumber( objSiteCollection.Attributes.GetNamedItem("StorageUsedMB").Text, 2) & "</td><td>" & objSiteCollection.Attributes.GetNamedItem("Owner").Text & "</td><td>" & objSiteCollection.Attributes.GetNamedItem("ContentDatabase").Text & "</td>" & vbCrLf

      datBackupStartTime = Now()
      
      Set intShellExecStatus = objShell.Exec(strCommandLine)
      Do While intShellExecStatus.Status = 0
        WScript.Sleep 100
      Loop
      strResult = objExec.StdOut.ReadAll

      strReportBody = strReportBody & "<td align=""right"">" & FormatNumber( DateDiff( "s", datBackupStartTime, Now() )/60, 2 ) & "</td><td>" & strResult & "</td></tr>"

  Next
  
  strReportBody = strReportBody & "<tr><td colspan=""6""><sup>1</sup> Size shown in MB<br /><sup>2</sup> Time shown in minutes rounded to nearest hundredth</td></tr></table>"
  
End If

WScript.Echo vbCrLf & "|==> Backup of site collections completed!"

If strErrorMessage <> "" Then
  strReportBody = strReportBody & "<table><tr><td class=""error"">[ERROR MESSAGE COLLECTION]<ul>" & strErrorMessage & "</ul></td></tr></table>"
End If

strReportFooter = strReportFooter & "</td></tr><tr><td class=""status"">" & vbCrLf & _
  "Done in " & FormatNumber( DateDiff( "s", datStart, Now() )/60, 2 ) & " minutes" & vbCrLf & _
  "</td></tr></table>" & vbCrLf & _
  "</body></html>" 

'======================================================
'    Report the results of the operation. 
'======================================================
Dim strSendMailError
Dim bolMailSent
strSendMailError = ""
bolMailSent      = False

If strNotification <> "" And strFromAddress <> "" Then
  strSendMailError = SendMail( strNotification, strFromAddress, "[BackupSiteCollections] " & Replace(Replace(Replace( LCase( strBaseUrl ),"http://",""),"https://",""),"/","_") & " - " & Replace(Replace( CStr( datStart ),"/","-"),":","."), strReportHeader & strReportBody & strReportFooter, strSmtpServer )
  If strSendMailError = "" Then
    bolMailSent = True
  Else
    strReportBody = strReportBody & strSendMailError
  End If
End If

If Not bolMailSent Then
  Dim strLogName
  Dim objLogFile
  strLogName = strLogFolder & "\BackupSiteCollections [" & Replace( Replace( Replace( LCase( Replace(Replace(Replace(strBaseUrl,"http://",""),"https://",""),"/","_") ) & "] " & CStr( Year(datStart)) & Right( "0" & CStr( Month(datStart)), 2) & Right( "0" & CStr( Day(datStart)), 2), "/", "][" ), ":", "" ), "\", "][" ) + ".htm"
  If Not objFileSystem.FolderExists( strLogFolder ) Then
    objFileSystem.CreateFolder( strLogFolder )
  End If
  Set objLogFile = objFileSystem.CreateTextFile( strLogName, True )
  objLogFile.Write( strReportHeader & strReportBody & strReportFooter )
  objLogFile.Close
  Set objLogFile = Nothing
End If

'============================================================================
' FUNCTIONS
'============================================================================
'-------------------------------------------------------------
' SendMail
'-------------------------------------------------------------
Function SendMail( strTo, strFrom, strSubject, strBody, strSmtpServer )

  Dim strMailComponent
  strMailComponent = ""

  Dim strErrorMessage
  strErrorMessage = ""
  
  Dim objMail
  Set objMail = CreateObject( "CDO.Message" )
  
  If Err.Number > 0 Then
    strErrorMessage = strErrorMessage & FormatErrorMessage( Err.Number, "[SendMail] " & Err.Description & " [creating CDOSYS object]")
    Err.Clear
    
    Set objMail = CreateObject( "CDONTS.NewMail" )

    If Err.Number > 0 Then
      ' strErrorMessage = strErrorMessage & FormatErrorMessage( Err.Number, "[SendMail] " & Err.Description & " [creating CDONTS object]")
      Err.Clear
    Else
      strMailComponent = "CDONTS"
    End If
  Else
    strMailComponent = "CDOSYS"
  End If


  If strMailComponent <> "" Then

    objMail.To = strTo
    objMail.Subject = strSubject

    Select Case strMailComponent
    Case "CDONTS"
      objMail.From = strFrom
      objMail.Body = strBody
      objMail.BodyFormat = 0
      objMail.MailFormat = 0
    
      objMail.Send

      If Err.Number > 0 Then
        strErrorMessage = FormatErrorMessage( Err.Number, "[SendMail] " & Err.Description & " [sending mail]")
        Err.Clear
      End If
    Case "CDOSYS"
      objMail.Sender = strFrom
      objMail.HTMLBody = strBody
    
      If strSmtpServer <> "" Then
        objMail.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
        objMail.Configuration.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        objMail.Configuration.Fields.Update
      End If

      objMail.Send
 
      If Err.Number > 0 Then
        strErrorMessage = FormatErrorMessage( Err.Number, "[SendMail] " & Err.Description & " [sending mail]")
        Err.Clear
      End If
    End Select

    Set objMail = Nothing

  End If

  SendMail = strErrorMessage

End Function

'-------------------------------------------------------------
' FormatErrorMessage
'-------------------------------------------------------------
Function FormatErrorMessage( intErrorNumber, strErrorDescription )
  FormatErrorMessage = "<li><em>ERROR:</em> (" & intErrorNumber & ") " & strErrorDescription & "</li>"
End Function

'======================================================
' EOF: BackupSiteCollections.vbs
'======================================================

I will follow up shortly with the rest of my process. Stay tuned!