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 . 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
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"
' Check to see if the file already exists exists
If objFSO.FolderExists(strDirectory) Then
Set objFolder = objFSO.GetFolder(strDirectory)
Set objFolder = objFSO.CreateFolder(strDirectory)
If objFSO.FileExists(strDirectory & strFile) Then
Set objFolder2 = objFSO.GetFolder(strDirectory)
Set objFile = objFSO.CreateTextFile(strDirectory & strFile)
' 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
For i = 1 To Len(input) Step 2
strSubString = Mid(input,i,2)
If Not strSubString = "00" Then strPath = strPath & ChrW("&H" & strSubString)
Select Case True
Case InStr(strPath,":\") > 0
GetPSTPath = Mid(strPath,InStr(strPath,":\")-1)
Case InStr(strPath,"\\") > 0
GetPSTPath = Mid(strPath,InStr(strPath,"\\"))
If err.number = vbEmpty then
Else WScript.echo "VBScript Error: " & err.number
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.
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.
Thanks for script. But i have a problem with output file characters. Russian letters in that file shows corrupted like "C:\Users\evg\Documents\$09;K Outlook\archive.pst" Plz! help resolve this problem! or maybe some advise help