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

Posted on 2006-04-06
Medium Priority
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
  • 3
  • 2
LVL 28

Accepted Solution

vinnyd79 earned 2000 total points
ID: 16395753
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 Const vbDot = 46
Public Const MAX_PATH As Long = 260
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

   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

Author Comment

ID: 16395914
will that work on all platforms?

win 98?  or just win nt?
LVL 28

Expert Comment

ID: 16396095
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.

Author Comment

ID: 16412704
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

ID: 16428727
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.

Featured Post

How to Use the Help Bell

Need to boost the visibility of your question for solutions? Use the Experts Exchange Help Bell to confirm priority levels and contact subject-matter experts for question attention.  Check out this how-to article for more information.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

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…
The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…
Suggested Courses
Course of the Month15 days, 18 hours left to enroll

850 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