I found the following Outlook code from an MVP to get the path/names of the
pst files in use and write the results to the immediate window. However, I'd
like to write the results to a text file instead (preferably with the
username as part of the filename); for example: C:\data\jdoe.txt or if not
just C:\data\olPST.txt. Thanks in advance for your assistance.


Sub EnumStorePaths()
'returns results in immediate window

Dim fld As Outlook.MAPIFolder
Dim strPath As String
On Error Resume Next
For Each fld In Application.Session.Folders
strPath = GetStorePath(fld.StoreID)
Debug.Print fld.Name, strPath
Next

End Sub


Function GetStorePath(strStoreID As String)
Dim intStart As Integer
Dim intEnd As Integer
Dim strProvider As String
Dim strPathRaw As String
intStart = InStr(9, strStoreID, "0000") + 4
intEnd = InStr(intStart, strStoreID, "00")
strProvider = _
Mid(strStoreID, intStart, intEnd - intStart)
strProvider = Hex2ToString(strProvider)
Select Case LCase(strProvider)
Case "mspst.dll", "pstprx.dll"
If Right(strStoreID, 6) = "000000" Then
'2003
intStart = InStrRev(strStoreID, "00000000") + 8
strPathRaw = Mid(strStoreID, intStart)
GetStorePath = Trim(Hex4ToString(strPathRaw))
Else
'97
intStart = InStrRev(strStoreID, "000000") + 6
strPathRaw = Mid(strStoreID, intStart)
GetStorePath = Trim(Hex2ToString(strPathRaw))
End If

Case "msncon.dll"
intStart = InStrRev(strStoreID, _
"00", Len(strStoreID) - 2) + 2
strPathRaw = Mid(strStoreID, intStart)
GetStorePath = Trim(Hex2ToString(strPathRaw))
Case "emsmdb.dll"
GetStorePath = "Exchange store"
Case Else
GetStorePath = "Unknown store path"
End Select
End Function

Public Function Hex4ToString(Data As String) As String
Dim strTemp As String
Dim strAll As String
Dim i As Integer
For i = 1 To Len(Data) Step 4
strTemp = Mid(Data, i, 4)
strTemp = "&H" & Right(strTemp, 2) & Left(strTemp, 2)
strAll = strAll & ChrW(CDec(strTemp))
Next
Hex4ToString = strAll
End Function

Public Function Hex2ToString(Data As String) As String
Dim strTemp As String
Dim strAll As String
Dim i As Integer
For i = 1 To Len(Data) Step 2
strTemp = "&H" & Mid(Data, i, 2)
strAll = strAll & ChrW(CDec(strTemp))
Next
Hex2ToString = strAll
End Function