Get PST file path string

[Diamonds_Mine]

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

 

[Eric Legault [MVP - Outlook]]

You can use the NameSpace.CurrentUser property to get the name of the logged
on user, and the TextStream object from the Microsoft Scripting Runtime
Library to write to a text file.

 

[Diamonds_Mine]

Thank you Eric; unfortunately I'm new to this and am not sure how to write
it, but will research. One more question -- the code below, can it only be
run from within Outlook or is there a way to run it using a vb script?

 

[Eric Legault [MVP - Outlook]]

Yes, you can convert your code to VBScript and have it run out-of-process
from Outlook. However, if you aren't using Outlook 2007 with "code trusting"
enabled, then some object model calls (like CurrentUser) will generate a
security warning dialog.

Here's a reference you can use for writing to a file:

TextStream Object:
http://msdn.microsoft.com/library/en-us/vbenlr98/html/vaobjTextStream.asp?frame=true

--
Eric Legault (Outlook MVP, MCDBA, MCTS: Messaging & Collaboration)
Try Picture Attachments Wizard for Outlook:
http://www.collaborativeinnovations.ca
Blog: http://blogs.officezealot.com/legault/

 

[Diamonds_Mine]

Apologies, but I need some "hand holding" -- what do I use to convert it to
VBScript?

 

[Eric Legault [MVP - Outlook]]

It's a manual process. You have to make sure you aren't declaring any data
types with your variables, change typed enumerations to numeric values, etc.

Use this for some guidelines:

Visual Basic for Applications Features Not In VBScript:
http://msdn.microsoft.com/library/e...00-fb5c-42b5-9051-b5338b67a8dc.asp?frame=true

--
Eric Legault (Outlook MVP, MCDBA, MCTS: Messaging & Collaboration)
Try Picture Attachments Wizard for Outlook:
http://www.collaborativeinnovations.ca
Blog: http://blogs.officezealot.com/legault/

 

[Eric Legault [MVP - Outlook]]

Sorry, I don't know how to do that. It would be a Win32 API function I'm
guessing.

BTW, you're not storing that .pst on a network share are you? You do know
that's a disaster waiting to happen?

--
Eric Legault (Outlook MVP, MCDBA, MCTS: Messaging & Collaboration)
Try Picture Attachments Wizard for Outlook:
http://www.collaborativeinnovations.ca
Blog: http://blogs.officezealot.com/legault/

 

[Diamonds_Mine]

Thank you Eric, I was able to convert. One more question using the code
below is there a way to have "GetStorePath" display the UNC path instead of
the mapped drive when it writes to the csv file.

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

Open "C:\data\test.csv" For Append As #1
Write #1, fld.Name, strPath ' Write data.

Next
Write #1, ' Write blank line.
Close #1 ' Close file.

 

[Diamonds_Mine]

Thank you Eric; unfortunately they are stored on the network and we're in the
process of identifying them and moving the information to the mailbox.