Find PST files configured in outlook

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

Find PST files configured in outlook

Logged in as: Guest

arrSession:exec spGetSession 2,16,44947

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> Post a VBScript >> Find PST files configured in outlook
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

Find PST files configured in outlook - 3/25/2007 11:34:17 PM

robszar

Posts: 176
Score: 0
Joined: 2/27/2005
From:
Status: offline

I have been looking for a way to find the PST files configured in Outlook, couldn't find anything so I figured it out and coded it.. I'm sure this will be helpful to a lot of people. The output gets written to a txt file in %temp%\pst.log

Enjoy!

Option Explicit
'On Error Resume Next
Const HKEY_CURRENT_USER = &H80000001
Const r_PSTGuidLocation = "01023d00"
Const r_MasterConfig = "01023d0e"
Const r_PSTCheckFile = "00033009"
Const r_PSTFile = "001f6700"
Const r_keyMaster = "9207f3e0a3b11019908b08002b2a56c2"
Const r_ProfilesRoot = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
Const r_DefaultOutlookProfile = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
Const r_DefaultProfileString = "DefaultProfile"
Dim oReg        :Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Dim objFSO    :Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim objPSTLog    :Set objPSTLog = objFSO.OpenTextFile(ExpandEvnVariable("Temp") & "\pst.log",2,True)    
Dim arrSubKeys, subkey, strValue, i, pstFile, arrPSTs, DefaultProfileName

oReg.GetStringValue HKEY_CURRENT_USER,r_DefaultOutlookProfile,r_DefaultProfileString,DefaultProfileName

objPSTLog.WriteLine(DefaultProfileName)
GetPSTsForProfile(DefaultProfileName)

objPSTLog.close
Set objPSTLog = Nothing    
'_____________________________________________________________________________________________________________________________
Function GetPSTsForProfile(p_profileName)
Dim strHexNumber, strPSTGuid, strFoundPST
Dim HexCount    :HexCount = 0

oReg.GetBinaryValue HKEY_CURRENT_USER,r_ProfilesRoot & "\" & p_profileName & "\" & r_keyMaster,r_MasterConfig,strValue
   For i = lBound(strValue) to uBound(strValue)    
           If Len(Hex(strValue(i))) = 1 Then 
               strHexNumber = "0" & Hex(strValue(i))
           Else
               strHexNumber = Hex(strValue(i))
           End If        
       strPSTGuid = strPSTGuid + strHexNumber
       HexCount = HexCount + 1
           If HexCount = 16 Then 
                   If IsAPST(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid) Then
                       'wscript.echo vbCrLf & "PST FOUND: " & PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid)
                       'strFoundPST = strFoundPST & "??" & PSTFileName(r_ProfilesRoot & "\" & p_profileName & "\" & PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid))
                       objPSTLog.WriteLine(PSTFileName(r_ProfilesRoot & "\" & p_profileName & "\" & PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid)))
                   End If    
               HexCount = 0
               strPSTGuid = ""
           End If            
   Next
   'GetPSTsForProfile = strFoundPST
End Function
'_____________________________________________________________________________________________________________________________
Function IsAPST(p_PSTGuid)
Dim x, P_PSTGuildValue
Dim P_PSTCheck:P_PSTCheck=0
IsAPST=False
oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTCheckFile,P_PSTGuildValue
   For x = lBound(P_PSTGuildValue) to uBound(P_PSTGuildValue)    
       P_PSTCheck = P_PSTCheck + Hex(P_PSTGuildValue(x))
   Next    
   If P_PSTCheck=20 Then
       IsAPST=True
   End If    
End Function 
'_____________________________________________________________________________________________________________________________
Function PSTlocation(p_PSTGuid)
Dim y, P_PSTGuildValue, t_strHexNumber
oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTGuidLocation,P_PSTGuildValue
   For y = lBound(P_PSTGuildValue) to uBound(P_PSTGuildValue)    
       If Len(Hex(P_PSTGuildValue(y))) = 1 Then
           PSTlocation = PSTlocation + "0" & Hex(P_PSTGuildValue(y))
       Else
           PSTlocation = PSTlocation + Hex(P_PSTGuildValue(y))    
       End If    
   Next    
End Function 
'_____________________________________________________________________________________________________________________________
Function PSTFileName(p_PSTGuid)
Dim z, P_PSTName
Dim strString:strString = ""
oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTFile,P_PSTName
   For z = lBound(P_PSTName) to uBound(P_PSTName)    
       If P_PSTName(z) > 0 Then
           strString = strString & Chr(P_PSTName(z))
       End If    
   Next    
   PSTFileName = strString
Set z = nothing
Set P_PSTName = nothing
End Function 
'_________________________________________________________________________________________________________
Function ExpandEvnVariable(ExpandThis)
Dim objWSHShell    :Set objWSHShell = CreateObject("WScript.Shell")
ExpandEvnVariable = objWSHShell.ExpandEnvironmentStrings("%" & ExpandThis & "%")
End Function
'_________________________________________________________________________________________________________

Post #: 1

RE: Find PST files configured in outlook - 3/26/2007 5:58:54 AM

Snipah

Posts: 1343
Score: 6
Joined: 11/1/2004
From: Netherlands
Status: offline

first impression: Looks nice (will definat. try)...poorly commented though.

_____________________________

For more information, please see the "Read me First" topic.

http://www.visualbasicscript.com

(in reply to robszar)

Post #: 2

RE: Find PST files configured in outlook - 3/26/2007 7:35:52 AM

robszar

Posts: 176
Score: 0
Joined: 2/27/2005
From:
Status: offline

I know, I know.. poor commented.....

I usually don't comment my scripts becuase I'm the only one reading them, BUT, the script rocks...

(in reply to Snipah)

Post #: 3

RE: Find PST files configured in outlook - 3/27/2007 1:36:02 AM

ickleric

Posts: 88
Score: 0
Joined: 11/15/2006
Status: offline

nice script, just what i was in the process of doing. nice one.

(in reply to robszar)

Post #: 4

RE: Find PST files configured in outlook - 4/24/2007 11:00:47 PM

sympathitekos

Posts: 1
Score: 0
Joined: 4/24/2007
Status: offline

Hi Mate,

Very nice script. I have tried it.
It would be great if we could generate the size of pst file.

Best Regards,

Sympathitekos

(in reply to robszar)

Post #: 5

RE: Find PST files configured in outlook - 5/1/2007 8:24:53 PM

chong

Posts: 74
Score: 0
Joined: 12/20/2006
Status: offline

fantastic work...im in the process of doing the slight opposite.

All of our user PST files are located in the same area on their homedrives i.e

if a users logon is ABC, the path would be \\path\ABC\mailsettings

thus, what im trying to do is reverse the conversion of hex data (reg_binary) from a string, prooving to be one hard pain in the ass. Before I go any futher with this, do you know whether this is actually possible?

Thanking you

(in reply to sympathitekos)

Post #: 6

RE: Find PST files configured in outlook - 5/1/2007 10:30:55 PM

chong

Posts: 74
Score: 0
Joined: 12/20/2006
Status: offline

baah asking before doing! ive got a script going...managed to get a way of adding the located pst files to the registry...all i need todo now is convert from ascii to hex using vbs.

Dim objNetwork, FSO, pstFolder

Dim strPSTpath, file, pstFiles

Set objNetwork = CreateObject("Wscript.Network")
strUser = objNetwork.UserName
strPSTPath = "\\fileserver\"&strUser&"\mailsettings"

'get PST filenames.

Set FSO = CreateObject("Scripting.FileSystemObject")

Set pstFolder = FSO.GetFolder(strPSTPath)

Set pstFiles = pstFolder.Files
strRegpath = "HKCU\SOFTWARE\Microsoft\Windows NT\currentVersion\Windows Messaging Subsystem\Profiles\MailProfile\"

For Each pst in pstFiles
wscript.echo pst
'convert to HEX character and place into a registry REG_BINARY KEY.

Next

(in reply to chong)

Post #: 7

RE: Find PST files configured in outlook - 6/14/2007 7:39:35 PM

ginolard

Posts: 1024
Score: 21
Joined: 8/10/2005
Status: offline

I've been tasked with writing a script to backup user's PST files so this script was an ideal starting point. I've tided it up a bit.

Option Explicit
Const HKEY_CURRENT_USER = &H80000001
Const r_PSTGuidLocation = "01023d00"
Const r_MasterConfig = "01023d0e"
Const r_PSTCheckFile = "00033009"
Const r_PSTFile = "001f6700"
Const r_keyMaster = "9207f3e0a3b11019908b08002b2a56c2"
Const r_ProfilesRoot = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
Const r_DefaultProfileString = "DefaultProfile"
Dim oReg        :Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
Dim arrSubKeys, subkey, strValue, i, pstFile, arrPSTs, DefaultProfileName

oReg.GetStringValue HKEY_CURRENT_USER,r_ProfilesRoot,r_DefaultProfileString,DefaultProfileName
GetPSTsForProfile(DefaultProfileName)
 
'_____________________________________________________________________________________________________________________________
Function GetPSTsForProfile(p_profileName)
   Dim strHexNumber, strPSTGuid, strFoundPST

oReg.GetBinaryValue HKEY_CURRENT_USER,r_ProfilesRoot & "\" & p_profileName & "\" & r_keyMaster,r_MasterConfig,strValue
   For Each i In strValue
       If Len(Hex(i)) = 1 Then 
           strHexNumber = CInt("0") & Hex(i)
       Else
           strHexNumber = Hex(i)
       End If        
       strPSTGuid = strPSTGuid + strHexNumber
       If Len(strPSTGuid) = 32 Then 
           If IsAPST(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid) Then
               Wscript.Echo PSTFileName(r_ProfilesRoot & "\" & p_profileName & "\" & _
                           PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid))
           End If    
       strPSTGuid = ""
       End If            
   Next
End Function
'_____________________________________________________________________________________________________________________________
Function IsAPST(p_PSTGuid)
   Dim x, P_PSTGuildValue
   Dim P_PSTCheck:P_PSTCheck=0
   IsAPST=False
   oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTCheckFile,P_PSTGuildValue
       For Each x in P_PSTGuildValue
           P_PSTCheck = P_PSTCheck + Hex(x)
       Next    
       If P_PSTCheck=20 Then
           IsAPST=True
       End If    
End Function 
'_____________________________________________________________________________________________________________________________
Function PSTlocation(p_PSTGuid)
   Dim y, P_PSTGuildValue
   oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTGuidLocation,P_PSTGuildValue
      For Each y In P_PSTGuildValue
          If Len(Hex(y)) = 1 Then
              PSTlocation = PSTlocation & CInt("0") & Hex(y)
          Else
              PSTlocation = PSTlocation & Hex(y)
          End If    
      Next    
End Function 
'_____________________________________________________________________________________________________________________________
Function PSTFileName(p_PSTGuid)
   Dim z, P_PSTName
   Dim strString : strString = ""
   oReg.GetBinaryValue HKEY_CURRENT_USER,p_PSTGuid,r_PSTFile,P_PSTName
       For Each z in P_PSTName
           If z > 0 Then strString = strString & Chr(z)
       Next    
   PSTFileName = strString
End Function 
'_________________________________________________________________________________________________________
Function ExpandEvnVariable(ExpandThis)
   Dim objWSHShell    :Set objWSHShell = CreateObject("WScript.Shell")
   ExpandEvnVariable = objWSHShell.ExpandEnvironmentStrings("%" & ExpandThis & "%")
End Function
'_________________________________________________________________________________________________________

_____________________________

Author of ManagePC - http://managepc.net
AD Query Template - http://www.visualbasicscript.com/m_40609/tm.htm
Consolidated Scripting Framework - http://www.visualbasicscript.com/m_59109/tm.htm

(in reply to chong)

Post #: 8

RE: Find PST files configured in outlook - 6/14/2007 11:33:47 PM

robszar

Posts: 176
Score: 0
Joined: 2/27/2005
From:
Status: offline

I just found a way to backup open PST files

So now I took the backup out of the login script and moved it to an SMS job that runs during the day....

if you want the hook up send me an email...

(in reply to ginolard)

Post #: 9

RE: Find PST files configured in outlook - 6/14/2007 11:52:41 PM

ginolard

Posts: 1024
Score: 21
Joined: 8/10/2005
Status: offline

I am absolutely convinced that you must be able to get this information using MAPI.

I'm buggered if I can find out how to do it though ;)

_____________________________

Author of ManagePC - http://managepc.net
AD Query Template - http://www.visualbasicscript.com/m_40609/tm.htm
Consolidated Scripting Framework - http://www.visualbasicscript.com/m_59109/tm.htm

(in reply to robszar)

Post #: 10

RE: Find PST files configured in outlook - 6/27/2007 5:12:15 PM

ginolard

Posts: 1024
Score: 21
Joined: 8/10/2005
Status: offline

HA! I knew it was possible.

Here's a way to get the information via MAPI.

< Message edited by ginolard -- 6/27/2007 5:36:29 PM >

_____________________________

Author of ManagePC - http://managepc.net
AD Query Template - http://www.visualbasicscript.com/m_40609/tm.htm
Consolidated Scripting Framework - http://www.visualbasicscript.com/m_59109/tm.htm

(in reply to ginolard)

Revisions: 1 | Post #: 11

RE: Find PST files configured in outlook - 6/29/2008 8:45:57 PM

L4suicide

Posts: 1
Score: 0
Joined: 6/24/2008
Status: offline

I need to take this script one further. But i'm afraid my knowledge of the registry is limited.

Is it possible to modify this to list the PST files on the default mail profile for a remote machine?

Sometimes i need to re-profile a user exactly how they had it set up before whatever change it is i've made thats removed their profile. Would be nice to have something that can list them all for me which i can add to a script i have to do a lot of other things :)

(in reply to robszar)

Post #: 12

RE: Find PST files configured in outlook - 7/24/2008 5:21:49 PM

TomRiddle

Posts: 165
Score: 4
Joined: 2/7/2008
Status: offline

if you are going to re-profile a user you will want to do it from their machine, but if their profile is messed up or they are not logged in this script probably would not work. I was thinking of writing a script that gets all profile settings, but there is a couple in Outlook I could not work out so thought it pointless to get some by script but not all.

Anyway I hacked on a bit of code I have used in the last couple of my scripts onto to this script to get the PST files in use on a remote machine.

Have not tidied it up so it is a bit messy but it works. Basically I added a prompt for remote computer and then find user logged into that machine, then his SID and then changed HKEY_CURRENT_USER everywhere to HKEY_USERS then query runs on remote machine.

Const HKEY_CURRENT_USER = &H80000001
Const HKEY_USERS  = &H80000003
Const r_PSTGuidLocation = "01023d00"
Const r_MasterConfig = "01023d0e"
Const r_PSTCheckFile = "00033009"
Const r_PSTFile = "001f6700"
Const r_keyMaster = "9207f3e0a3b11019908b08002b2a56c2"
Const r_DefaultProfileString = "DefaultProfile"
Dim oReg, strComputer
Dim arrSubKeys, subkey, strValue, i, pstFile, arrPSTs, DefaultProfileName
strComputer = inputbox("Enter Remote Computer name to find PST files in use on that computer")
CU=GetCurrentUser(strComputer)
CUSID = GetSIDFromUser(CU)
r_ProfilesRoot = CUSID&"\Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" &_ 
  strComputer & "\root\default:StdRegProv")

oReg.GetStringValue HKEY_USERS,r_ProfilesRoot,r_DefaultProfileString,DefaultProfileName
GetPSTsForProfile(DefaultProfileName)

'_____________________________________________________________________________________________________________________________
Function GetPSTsForProfile(p_profileName)
  Dim strHexNumber, strPSTGuid, strFoundPST
  oReg.GetBinaryValue HKEY_USERS,r_ProfilesRoot & "\" & p_profileName & "\" & r_keyMaster,r_MasterConfig,strValue
  For Each i In strValue
      If Len(Hex(i)) = 1 Then 
          strHexNumber = CInt("0") & Hex(i)
      Else
          strHexNumber = Hex(i)
      End If        
      strPSTGuid = strPSTGuid + strHexNumber
      If Len(strPSTGuid) = 32 Then 
          If IsAPST(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid) Then
              Wscript.Echo PSTFileName(r_ProfilesRoot & "\" & p_profileName & "\" & _
                          PSTlocation(r_ProfilesRoot & "\" & p_profileName & "\" & strPSTGuid))
          End If    
      strPSTGuid = ""
      End If            
  Next
End Function
'_____________________________________________________________________________________________________________________________
Function IsAPST(p_PSTGuid)
  Dim x, P_PSTGuildValue
  Dim P_PSTCheck:P_PSTCheck=0
  IsAPST=False
  oReg.GetBinaryValue HKEY_USERS,p_PSTGuid,r_PSTCheckFile,P_PSTGuildValue
      For Each x in P_PSTGuildValue
          P_PSTCheck = P_PSTCheck + Hex(x)
      Next    
      If P_PSTCheck=20 Then
          IsAPST=True
      End If    
End Function 
'_____________________________________________________________________________________________________________________________
Function PSTlocation(p_PSTGuid)
  Dim y, P_PSTGuildValue
  oReg.GetBinaryValue HKEY_USERS,p_PSTGuid,r_PSTGuidLocation,P_PSTGuildValue
     For Each y In P_PSTGuildValue
         If Len(Hex(y)) = 1 Then
             PSTlocation = PSTlocation & CInt("0") & Hex(y)
         Else
             PSTlocation = PSTlocation & Hex(y)
         End If    
     Next    
End Function 
'_____________________________________________________________________________________________________________________________
Function PSTFileName(p_PSTGuid)
  Dim z, P_PSTName
  Dim strString : strString = ""
  oReg.GetBinaryValue HKEY_USERS,p_PSTGuid,r_PSTFile,P_PSTName
      For Each z in P_PSTName
          If z > 0 Then strString = strString & Chr(z)
      Next    
  PSTFileName = strString
End Function 
'_________________________________________________________________________________________________________
Function ExpandEvnVariable(ExpandThis)
  Dim objWSHShell    :Set objWSHShell = CreateObject("WScript.Shell")
  ExpandEvnVariable = objWSHShell.ExpandEnvironmentStrings("%" & ExpandThis & "%")
End Function
'_________________________________________________________________________________________________________
Function GetCurrentUser(strComputer) 
'Input: strComputer = machine to query 
'Output: Current User as domain\logon 
'Only works on XP/W2003
  on error resume next
  Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2") 
  Set colProcessList = objWMIService.ExecQuery("Select * from Win32_Process Where Name = 'explorer.exe'") 
  For Each objProcess in colProcessList 
     objProcess.GetOwner strUserName, strUserDomain 
  Next 
  GetCurrentUser = strUserDomain & "\" & strUserName 
  if err<> 0 then
     Msgbox " Error accessing remote machine"
     wscript.quit
  end if
  on error goto 0
End Function 
'-----------------------------------------------------------------------
Function GetSIDFromUser(UserName) 
'Input: UserName as domain\logon 
'Output: SID 
  Dim DomainName, Result, WMIUser 
  If InStr(UserName, "\") > 0 Then 
     DomainName = Mid(UserName, 1, InStr(UserName, "\") - 1) 
     UserName = Mid(UserName, InStr(UserName, "\") + 1) 
  Else 
     DomainName = CreateObject("WScript.Network").UserDomain 
  End If 
  On Error Resume Next 
  Set WMIUser = GetObject("winmgmts:{impersonationlevel=impersonate}!" _ 
     & "/root/cimv2:Win32_UserAccount.Domain='" & DomainName & "'" _ 
        & ",Name='" & UserName & "'") 
  If Err = 0 Then 
     Result = WMIUser.SID 
  Else 
     msgbox "Error retrieving SID"
     wscript.quit
  end if
  On Error GoTo 0 
  GetSIDFromUser = Result 
End Function 
'-----------------------------------------------------------------------

(in reply to L4suicide)

Post #: 13

If you found our site useful please link to us <a href="http://www.visualbasicscript.com">VisualBasicScript.com</a>.

All Forums >> [Scripting] >> Post a VBScript >> Find PST files configured in outlook

Page: [1]

Jump to:

New Messages	No New Messages
Hot Topic w/ New Messages	Hot Topic w/o New Messages
Locked w/ New Messages	Locked w/o New Messages

Post New Thread

Reply to Message

Post New Poll

Submit Vote

Delete My Own Post

Delete My Own Thread

Rate Posts