Scripting: Listing PST files in an outlook profile

  • Article

One of my clients was in a nasty situation, he had a ton of users with PST files on the fileserver and they wanted that changed. Understandable as it is an unsupported situation Smile. Now the real problem is that every option we went over required a ton of manual labor which, in an environment of 20 000 mailboxes with hot desks, was not an option. So with the clients requirements in hand I created a vbs script which would work for all of their workstations (running different OS and outlook versions –_- ) and could be used to collect data on where the PST files are located….

 

  

  
  
 Dim objNetworkSet, objFSO, objFolder, objShell, objTextFile, objFile, objWMISysEnv,ObjItem, objTextFileUNC
 Dim strHomePath, strDirectory, strFile, strText, strComputerName,strDirectoryUNC,strFileUNC
 dim colItems
  
 Set objNetwork = CreateObject("WScript.Network")
 Set objOutlook = CreateObject("Outlook.Application")
 Set objNS = objOutlook.GetNamespace("MAPI")
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set wshShell = WScript.CreateObject("WScript.Shell")
  
 ' Setting file names
 strDirectory = "c:\users\marcdek\temp"
 strFile = "\" & ObjNetwork.Username &"-PSTOUTPUT.txt"
  
 strDirectoryUNC=
 strFileUNC=
  
 ' Check to see if the file already exists exists
 If objFSO.FolderExists(strDirectory) Then
    Set objFolder = objFSO.GetFolder(strDirectory)
 Else
    Set objFolder = objFSO.CreateFolder(strDirectory)
 End If
  
 If objFSO.FileExists(strDirectory & strFile) Then
    Set objFolder2 = objFSO.GetFolder(strDirectory)
 Else
    Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
 End If 
  
 ' OpenTextFile Method needs a Const value
 ' ForAppending = 8 ForReading = 1, ForWriting = 2
 Const ForAppending = 8
  
 ' Opening text file
 Set objTextFile = objFSO.OpenTextFile(strDirectory & strFile, ForAppending, True)
 Set objTextFileUNC= objFSO.OpenTextFile(strDirectory & strFile, ForAppending, True)
 ' Here we go!
 For Each objFolder2 In objNS.Folders
      objTextFile.WriteLine(GetPSTPath(objFolder2.StoreID))
      objTextFileUNC.WriteLine(GetPSTPath(objFolder2.StoreID))
  Next
   
  Function GetPSTPath(input)
      For i = 1 To Len(input) Step 2
          strSubString = Mid(input,i,2)    
         If Not strSubString = "00" Then strPath = strPath & ChrW("&H" & strSubString)
      Next
     
     Select Case True
          Case InStr(strPath,":\") > 0  
             GetPSTPath = Mid(strPath,InStr(strPath,":\")-1)
          Case InStr(strPath,"\\") > 0  
             GetPSTPath = Mid(strPath,InStr(strPath,"\\"))
      End Select
  End Function
  
  
 If err.number = vbEmpty then
   Else WScript.echo "VBScript Error: " & err.number
 End If