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