Code Snippet
' Back up the WSS sites...
' 〞〞〞〞〞〞〞〞〞〞〞〞〞〞〞-
Const STSADM_PATH = _
"C:\Program Files\Common Files\Microsoft Shared\" & _
"web server extensions\60\BIN\stsadm"
Const BACKUP_DIR = "E:\WSSBackups\"
Const SHAREPOINT_URL = "http://extwss01/"
Dim strBackupFolder
strBackupFolder = BACKUP_DIR & CStr(Year(Now())) & "\" & _
CStr(Month(Now())) & "\" & CStr(Day(Now()))
Dim objFso, objFolder, objFiles, objFile, objShell, objExec
Dim strResult, objXml, objSc, objUrl, strUrl
Dim strFileName, strCmd
Set objFso = CreateObject("Scripting.FileSystemObject")
' Delete all backup files currently present in the backup folder.
If objFso.FolderExists(strBackupFolder) Then
Set objFolder = objFso.GetFolder(strBackupFolder)
Set objFiles = objFolder.Files
For Each objFile in objFiles
objFile.Delete(True)
Next
Else
CreateBackupFolder strBackupFolder, objFso
End If
' Retrieve all site collections in XML format.
Set objShell = CreateObject("WScript.Shell")
Set objExec = objShell.Exec(STSADM_PATH & " -o enumsites -url " & SHAREPOINT_URL)
strResult = objExec.StdOut.ReadAll
' Load XML in DOM document so it can be processed.
Set objXml = CreateObject("MSXML2.DOMDocument")
objXml.LoadXML(strResult)
' Loop through each site collection and call stsadm.exe to make a backup.
For Each objSc in objXml.DocumentElement.ChildNodes
strUrl = objSc.Attributes.GetNamedItem("Url").Text
strFileName = strBackupFolder & "\" & _
Replace(Replace(strUrl, "http://", ""), "/", "_") & _
".spb"
strCmd = STSADM_PATH & " -o backup -url """ + strUrl & _
+ """ -filename """ + strFileName + """"
objShell.Exec(strCmd)
Next
WScript.Echo "WSS Backup complete."
Sub CreateBackupFolder(strFolderName, fs)
'This subroutine creates the appropriate folder structure
' if it does not already exist
If Left(strFolderName, 2) = "\\" Then
folderparts = Split(strFolderName, "\")
strCurrent = "\\" & folderparts(2) & "\" & _
folderparts(3) & "\"
folderparts = Split(Right(strFolderName, Len(strFolderName) - _
Len(strCurrent)), "\")
Else
folderparts = Split(strFolderName, "\")
strCurrent = folderparts(0) & "\"
folderparts = Split(Right(strFolderName, Len(strFolderName) - _
Len(strCurrent)), "\")
End If
For Each folderpart In folderparts
strCurrent = strCurrent & "\" & folderpart
If Not fs.FolderExists(strCurrent) Then
fs.CreateFolder strCurrent
End If
Next
End Sub