Scripting – Back up PST file

Posted by dmitry on May 26, 2010 in Scripting | 0 comments

Option Explicit
Const OverwriteExisting = True

Dim objWMIService
Dim objFileOut
Dim objTextFile
Dim strDriveName
Dim WshNetwork
Dim strUserName
Dim colDisks
Dim objDisk
Dim strDate
Dim colItems
Dim objItems
Dim PST_array(500)
Dim PST_i_counter
Dim k
Dim strFolderName
Dim arrFolderPath
Dim strNewPath
Dim i
Dim objFSO
Dim objFolder
Dim FileWritePath
Dim DocumentationFile
Set objWMIService = GetObject(“winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2″)

PST_i_counter = 0
‘Gets current username
Set WshNetwork = WScript.CreateObject(“WScript.Network”)
strUserName = WshNetwork.UserName

strDate = “”
Set colItems = objWMIService.ExecQuery(“Select * from Win32_UTCTime”)
strDate = “”
For Each objItems in colItems
strDate = objItems.Month & “-” & objItems.Day & “-”  & objItems.Year & “-” & objItems.Hour & “:” & objItems.Minute & “:” & objItems.Second
Next

‘A text file will be created with the username that outputs the date/time and the files copied (both from where and to where they are copied)
‘The first line is a test, the second is for RCE’s current setup
‘DocumentationFile = “C:\PST\” & strUserName & “.txt”
DocumentationFile = “\\serverNameHere\shareName\Mail Backup Reports\” & strUserName & “.txt”

Set colDisks = objWMIService.ExecQuery(“Select * from Win32_LogicalDisk”)

For Each objDisk in colDisks
If objDisk.DriveType = 3 Then
strDriveName =  objDisk.DeviceID
strFolderName = strDriveName
GetSubFolders strFolderName
End If
Next

‘Path to write files, first is a test directory, second is the path to the RCEServer that end users will need.  The directory path will be created if necessary.
‘FileWritePath = “c:\PST_copy\”
FileWritePath = “\\serverNameHere\shareName\” & strUserName &”\mail\”

Set objFileOut = CreateObject(“Scripting.FileSystemObject”)

If objFileOut.FileExists(DocumentationFile) Then
Set objTextFile = objFileOut.OpenTextFile(DocumentationFile,8, True)
Else
Set objTextFile = objFileOut.CreateTextFile(DocumentationFile, True)
End If

objTextFile.WriteLine

“********************************************************************************************************************************************************”
objTextFile.WriteLine strDate

For k = 0 To 499
If PST_array(k) <> “” Then
strFolderName = Left(PST_array(k), 1) & “\” & Right(PST_array(k), Len(PST_array(k)) – InStr(PST_array(k),”:”) – 1)
strFolderName = FileWritePath & strFolderName

arrFolderPath = Split(strFolderName, “\”)
strNewPath = “”
For i = 0 to Ubound(arrFolderPath) – 1
‘This is for when the path to write to is C:\, for testing purposes
‘                If i = 0 Then
‘                    strNewPath = arrFolderPath(i) & “\”
‘This is the path specific to allow writing to the Rceserver – comment the above two lines out if using this.
If i < 4 Then
strNewPath = “\\serverNameHere\shareName”
Else
If i=1 Then
strNewPath = strNewPath & arrFolderPath(i)
Else
strNewPath = strNewPath & “\” & arrFolderPath(i)
End If
End If
Set objFSO = CreateObject(“Scripting.FileSystemObject”)
Set objFSO=CreateObject(“Scripting.FileSystemObject”)
If not objFSO.FolderExists(strNewPath) Then
objFSO.CreateFolder(strNewPath)
End iF
Next

Set objFSO = CreateObject(“Scripting.FileSystemObject”)
‘        WScript.Echo PST_array(k) & ” was copied to ” & strFolderName
objFSO.CopyFile PST_array(k) , strFolderName, OverwriteExisting
objTextFile.WriteLine PST_array(k) & ” was copied to ” & strFolderName
End If
Next

objTextFile.Close

‘***********************************************************************************************************************************************************

***
‘***********************************************************************************************************************************************************

***

Sub GetSubFolders(strFolderName)
Dim colSubfolders2
Dim objFolder2
Dim arrFolderPath
Dim strNewPath
Dim i
Dim strPath
Dim colFiles
Dim objFile

Set colSubfolders2 = objWMIService.ExecQuery(“Associators of {Win32_Directory.Name=’” & strFolderName & “‘} Where AssocClass = Win32_Subdirectory ResultRole = PartComponent”)
For Each objFolder2 in colSubfolders2
on error resume next
strFolderName = objFolder2.Name
arrFolderPath = Split(strFolderName, “\”)
strNewPath = “”
For i = 1 to Ubound(arrFolderPath)
strNewPath = strNewPath & “\\” & arrFolderPath(i)
Next
strPath = strNewPath & “\\”

Set colFiles = objWMIService.ExecQuery(“Select * from CIM_DataFile where Path = ‘” & strPath & “‘ and Extension=’pst’”)
For Each objFile in colFiles
‘            WScript.Echo objFile.Name
PST_array(PST_i_counter) = objFile.Name
PST_i_counter = PST_i_counter + 1
Next
GetSubFolders strFolderName
On error goto 0
Next

End Sub
‘***********************************************************************************************************************************************************

***
‘***********************************************************************************************************************************************************

***
‘Wscript.echo “PST Done”