
Microsoft Access Office VB VBA Help and Examples

How to get in code the filenames of your Outlook Personal Folder pst files

When using both NT based machines ad Windows 95/98 machines it is sometimes necessary to be able to link all the same Personal folder files so you can map them all automatically on the other machine. The following code will dig out the file names of all your personal folders on a Windows NT machine with Outlook 2000 (Works with 98/97 but not fully tested).

Note if you are migrating a whole pile of users from Windows 98 you could either use this code, or export the registry branch and reimport in there windows nt profile.

You will need the freturnregkey code from Dev Ashish's site so that you can read values from the registry. http://www.mvps.org/access/api/api0015.htm. Save that as a module in your outlook Visual Basic session.

Then in the This outlook session module put the following

Public Function GetFolderFile()
   'Gets a users presonal folder file locations
   Dim PathToPST As String
   Dim KeyValue As String
   Dim NumFolders As Long
   Dim KeyName As String
   Dim PSTKeyName As String
   Dim PstKeyValue As String
   Dim x As Long
   Dim tmpstr As String
   Dim KeyPath As String
   'Root to where registry stores the outlook settings
   KeyPath = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles\"
   'get the default outlook profile option stored in the registry and add it to the key path
   KeyValue = fReturnRegKeyValue(HKEY_CURRENT_USER, KeyPath, "DefaultProfile")
   KeyPath = KeyPath & KeyValue & "\"
   'Value of users keys (This splits into 16 byte chunks for the next part
   KeyValue = fReturnRegKeyValue(HKEY_CURRENT_USER, KeyPath & "9207f3e0a3b11019908b08002b2a56c2", "01023d00")
   NumFolders = Len(KeyValue) / 16
   For x = 1 To NumFolders
      'Get next key name from list
      KeyName = Mid(KeyValue, ((x - 1) * 16) + 1, 16)
      KeyName = BinarySTRToText(Trim(KeyName))
      PSTKeyName = KeyPath & KeyName
      'Go get the value for the personal folder file
      PstKeyValue = fReturnRegKeyValue(HKEY_CURRENT_USER, PSTKeyName, "001e6700")
      If PstKeyValue <> "Error: Key or Value Not Found." Then
         'Is a personal folder file
         GetFolderFile = GetFolderFile & "Personal=" & PstKeyValue & vbCrLf
      End If
   Next
   GetFolderFile = Left(GetFolderFile, Len(GetFolderFile) - 2) 'Strip off the last carriage return
End Function

Private Function BinarySTRToText(BinaryStr As String) As String
   Dim i As Long
   Dim xlong As Long
   Dim xstr As String
   Dim xvar As Variant
   For i = 1 To Len(BinaryStr)
      xstr = Mid(BinaryStr, i, 1)
      xlong = CLng(Asc(xstr))
      xvar = Hex(xlong)
      xstr = CStr(xvar)
      If Len(xstr) = 1 Then xstr = "0" & xstr
      BinarySTRToText = BinarySTRToText & xstr
   Next
End Function

Private Sub Application_Quit()
   GetFolderFile
End Sub

The reason I run it in the application_quit is so I always pick up the latest set of personal folder files that are currently connected. Of course you can run this code anywhere as it is looking at the registry. The reason I use it in outlook is that I can automatically run it when relevant.

To run it on a windows 95/98 machine substitue the keypath= line for

KeyPath = "Software\Microsoft\Windows\Windows Messaging Subsystem\Profiles\"

HOME SEARCH SITE PRIVACY POLICY CONTACT

The code and application content of this site is copyright of Smiley I.T. and as such reproduction in any form which is for commercial use requires the permission of the Webmaster. Any use of this code for non-commercial use only requires a link or comment back to the original page you took the code from.