how do I find the path to the outlook profile PSTs from VB

outlook creates user profiles on a compute r- and within a user profile is usually specified a several PST files

from within VB - how would I identify the list of outlook profiles - and the paths to the PSTs associated with each outlook profile?
LVL 4
kenshawAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

vinnyd79Commented:
Add this to a .bas module:

Option Explicit
Public Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Public Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" _
  (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function FindNextFile Lib "kernel32" Alias "FindNextFileA" _
  (ByVal hFindFile As Long, lpFindFileData As WIN32_FIND_DATA) As Long
Public Declare Function lstrlen Lib "kernel32" _
    Alias "lstrlenW" (ByVal lpString As Long) As Long
Public Declare Function PathMatchSpec Lib "shlwapi" Alias "PathMatchSpecW" _
  (ByVal pszFileParam As Long, ByVal pszSpec As Long) As Long
Public FP As FILE_PARAMS

Public Const vbDot = 46
Public Const MAX_PATH As Long = 260
Public Const INVALID_HANDLE_VALUE = -1
Public Const vbBackslash = "\"
Public Const ALL_FILES = "*.*"
Public Const MAXDWORD As Long = &HFFFFFFFF
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10

Public Type FILETIME
   dwLowDateTime As Long
   dwHighDateTime As Long
End Type

Public Type WIN32_FIND_DATA
   dwFileAttributes As Long
   ftCreationTime As FILETIME
   ftLastAccessTime As FILETIME
   ftLastWriteTime As FILETIME
   nFileSizeHigh As Long
   nFileSizeLow As Long
   dwReserved0 As Long
   dwReserved1 As Long
   cFileName As String * MAX_PATH
   cAlternate As String * 14
End Type

Public Type FILE_PARAMS
   bRecurse As Boolean
   nCount As Long
   nSearched As Long
   sFileNameExt As String
   sFileRoot As String
End Type

Public Function QualifyPath(spath As String) As String
If Right$(spath, 1) <> vbBackslash Then
    QualifyPath = spath & vbBackslash
Else
    QualifyPath = spath
End If
End Function

Public Function TrimNull(startstr As String) As String
   TrimNull = Left$(startstr, lstrlen(StrPtr(startstr)))
End Function

Public Function MatchSpec(sFile As String, sSpec As String) As Boolean
    MatchSpec = PathMatchSpec(StrPtr(sFile), StrPtr(sSpec))
End Function


Public Sub FileSearch(StartPath As String)
With FP
    .sFileRoot = QualifyPath(StartPath)
    .sFileNameExt = "*.pst"
    .bRecurse = 1
    .nCount = 0
    .nSearched = 0
End With

Call SearchForFiles(FP.sFileRoot)

End Sub

Public Sub SearchForFiles(sRoot As String)
Dim WFD As WIN32_FIND_DATA, hFile As Long

hFile = FindFirstFile(sRoot & ALL_FILES, WFD)

If hFile <> INVALID_HANDLE_VALUE Then
   Do
         If (WFD.dwFileAttributes And vbDirectory) Then
            If Asc(WFD.cFileName) <> vbDot Then
             If FP.bRecurse Then
                  SearchForFiles sRoot & TrimNull(WFD.cFileName) & vbBackslash
             End If
            End If
         Else
            If MatchSpec(WFD.cFileName, FP.sFileNameExt) Then
                FP.nCount = FP.nCount + 1
                MsgBox sRoot & TrimNull(WFD.cFileName)
            End If
         End If
         DoEvents
    Loop While FindNextFile(hFile, WFD)
End If
Call FindClose(hFile)
End Sub




Then add this to a form with a command button:

' in declarations area at top of form
Option Explicit
Dim UserProfileList As Collection


Private Sub Command1_Click()
LoadProfileList
Dim i As Integer
For i = 1 To UserProfileList.Count
    Call FileSearch(UserProfileList.Item(i))
Next i

End Sub


Private Sub LoadProfileList()
Set UserProfileList = New Collection
Dim BaseDir As String, strFolder As String
BaseDir = Environ("UserProfile")
BaseDir = Left$(BaseDir, InStrRev(BaseDir, "\") - 1) & "\"
strFolder = Dir(BaseDir, vbDirectory + vbHidden)
Do While strFolder <> ""
    If strFolder <> "." And strFolder <> ".." Then
        If (GetAttr(BaseDir & strFolder) And vbDirectory) Then
            UserProfileList.Add BaseDir & strFolder
        End If
    End If
    strFolder = Dir()
    DoEvents
Loop

End Sub

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
kenshawAuthor Commented:
will that work on all platforms?

win 98?  or just win nt?
vinnyd79Commented:
It will work on all NT based systems and could possibly work on Win98 if there are multiple profiles set up on it. I don't have win98 here to test with.
kenshawAuthor Commented:
actually - i've just run this code - and that doesn't give me the path to the PSTs - it just gives me the path to the different profile directories
vinnyd79Commented:
It should give you the path to the PST's as the code is only looking for pst files.
The code looks for the pst files in the User Profile's directories. Could there be pst files outside of the user profiles? If so,you might want to search the entire drive for pst files instead.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.