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

Posted on 2006-04-06
Last Modified: 2010-05-01
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?
Question by:kenshaw
    LVL 28

    Accepted Solution

    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 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
        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 (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
                If MatchSpec(WFD.cFileName, FP.sFileNameExt) Then
                    FP.nCount = FP.nCount + 1
                    MsgBox sRoot & TrimNull(WFD.cFileName)
                End If
             End If
        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()
    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()

    End Sub
    LVL 4

    Author Comment

    will that work on all platforms?

    win 98?  or just win nt?
    LVL 28

    Expert Comment

    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.
    LVL 4

    Author Comment

    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
    LVL 28

    Expert Comment

    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.

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    Enabling OSINT in Activity Based Intelligence

    Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

    I’ve seen a number of people looking for examples of how to access web services from VB6.  I’ve been using a test harness I built in VB6 (using many resources I found online) that I use for small projects to work out how to communicate with web serv…
    Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
    Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
    This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

    759 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    14 Experts available now in Live!

    Get 1:1 Help Now