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
Thursday, June 6, 2013
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
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
Subscribe to:
Posts (Atom)