March 7, 2017 fiducheah

Had to do a rip and replace of Office 2010/2013 with o365 Office 2016 using SCCM.  As a precursor, the customer wanted to ensure their user’s PST files are inventoried and added back upon the creation of their default Outlook profile in Office 2016.  PowerShell doesn’t do a particularly good job of this, so it’s back to VBScript (I borrowed the script from someone and made modifications).

Using SCCM (customer didn’t want to use logon scripts) I forced the program to run the VBscript under the user’s context continuously.  Assuming there are multiple users using the same computer, we want to give it as much time as possible for this script to run.  Even though SCCM re-runs this script, it has conditions to bypass if the text file containing their PST files already exists.


PST Inventory Script:

On error resume next

Set objNetwork = CreateObject(“WScript.Network”)
Set objFSO = CreateObject(“Scripting.FileSystemObject”)

set objOutlook = createObject(“Outlook.Application”)
set objMAPI = objOutlook.GetNamespace(“MAPI”)

strFile = “c:\temp\” & ObjNetwork.Username &”-PST.txt”

If (objFSO.FileExists(strfile)) Then
Set objFile = objFSO.CreateTextFile(strFile, True)

for each PSTFolder In objMAPI.Folders
pstPath = GetPath(PSTFolder.StoreID)

if pstPath <> “” then
objFile.WriteLine pstPath
end if

End iF

function GetPath(input)
for i = 1 To Len(input) Step 2
strSubString = Mid(input,i,2)
if Not strSubString = “00” Then
strPath = strPath & ChrW(“&H” & strSubString)
end If
select Case True
case InStr(strPath,”:\”) > 0
GetPath = Mid(strPath,InStr(strPath,”:\”)-1)
case InStr(strPath,”\\”) > 0
GetPath = Mid(strPath,InStr(strPath,”\\”))
end Select
end Function


Script to re-add it back:

On error resume next

Const ForReading = 1
Dim arrFileLines()
Dim objNetwork,ObjFSO,objFile,objNet,objOutlook


Set objnet = CreateObject(“”)
Set objFSO = CreateObject(“Scripting.FileSystemObject”)

strFile = “c:\temp\” & ObjNet.Username &”-PST.txt”
Set objFile = objFSO.OpenTextFile(strFile, ForReading)
Set objFSO = CreateObject(“Scripting.FileSystemObject”)
Set objOutlook = CreateObject(“Outlook.Application”)

Do Until objFile.AtEndOfStream
Redim Preserve arrFileLines(i)
arrFileLines(i) = objFile.ReadLine
i = i + 1


For Each strPath in arrFileLines
objOutlook.Session.Addstore strPath


Leave a Reply

Your email address will not be published. Required fields are marked *