Thursday, June 6, 2013

VBScript Mount PST File on Outlook

Mount the PST files from list on Outlook.
PST Files list save in pstlist.txt
File Name openpst.vbe

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile("pstlist.txt")
set objOutlook = createObject("Outlook.Application")
set objMAPI = objOutlook.GetNamespace("MAPI")
do while not objFile.AtEndOfStream
    fPath =  objFile.ReadLine()
    objMAPI.AddStore fPath
loop

VBScript get Outlook PST files list

Get Outlook mounted PST Files list. And save file list to pstlist.txt.

File name: getpstlist.vbe

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.CreateTextFile("pstlist.txt", True)
set objOutlook = createObject("Outlook.Application")
set objMAPI = objOutlook.GetNamespace("MAPI")
for each PSTFolder In objMAPI.Folders
  pstPath = GetPath(PSTFolder.StoreID)
  if pstPath <> "" then
    objFile.WriteLine pstPath
  end if
next
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
  next
  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