Messaging and beyond!

Tales of an MS Exchange PFE

Scripting: Listing PST files in an outlook profile

Scripting: Listing PST files in an outlook profile

  • Comments 8
  • Likes

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
Comments
  • please correct me if i am wrong, but isn't this script the same as the one posted here: blogs.technet.com/.../scripting-adding-pst-files-to-an-outlook-profile-automatically.aspx

    to add the PSTs to the Outlook profile?

    Also, there is a PST discovery tool that was recently rolled out by MS to perform these steps through a GUI - PST Capture www.microsoft.com/.../details.aspx

  • Fixed it :)

  • On the PST Discovery tool: This script only lists the PSTs. The client in question wanted to keep pst files in place but know where they were and move them to local discs.

  • Great script... but.. I have a need to:- connect any new users to a particular Windows 7 Pro (outlook 2007) machine to ALL PST files within C:\Outlook\*.pst could I be cheeky and ask for assistance on this one please? the computer - due to restrictions - is NOT part of a domain. and I am an administrator. Many Thanks

  • XOUser8334, have a look at this one: http://blogs.technet.com/b/messaging_and_beyond/archive/2012/05/10/scripting-adding-pst-files-to-an-outlook-profile-automatically.aspx With some adaptation it should be possible to get a list of all files with a PST extension and connect them in to outlook

  • can u please tell me which part that need to modify to make this script work at my pc?

  • Thanks for the script, have used it (modified slightly) and it works well. Thanks for sharing. couple of comments though... The line "Set objFile = objFSO.CreateTextFile(strDirectory & strFile)" that creates a new file if the output file doesn't exist holds the file locked so that the line fails with access denied the first time the script runs. The first line is in fact completely unnecessary as the later command will create the file if it doesn't exist. Otherwise you should have objFile.close after creating the file. Also the script produces several blank lines in the output folder which is a minor annoyance, but can be filtered out using Trim. The output file is constantly appended to, not updated. So if you were to use this in a login script for example you would quickly have the same PST's listed over and over (Change for ForAppending to ForWriting to change this) noob: there are several changes that are necessary to make this work on a local PC. change the line strDirectory = "c:\users\marcdek\temp" so that the path is where you want to save the txt file find and delete the following lines entirely: strDirectoryUNC= strFileUNC= ------------ If objFSO.FileExists(strDirectory & strFile) Then Set objFolder2 = objFSO.GetFolder(strDirectory) Else Set objFile = objFSO.CreateTextFile(strDirectory & strFile) End If ------------ objTextFileUNC.WriteLine(GetPSTPath(objFolder2.StoreID))

  • I am getting this error when I run this VB script.
    Microsoft VBScript runtime error: ActiveX component can't createobject: 'Outlook.Application' Please advice what I am doing wrong.

Your comment has been posted.   Close
Thank you, your comment requires moderation so it may take a while to appear.   Close
Leave a Comment