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

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.

--
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" wrote:

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

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]" wrote:

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.

--
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" wrote:

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

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...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" wrote:

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]" wrote:

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.

--
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" wrote:

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

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

"Eric Legault [MVP - Outlook]" wrote:

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...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" wrote:

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]" wrote:

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.

--
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" wrote:

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

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/en...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" wrote:

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

"Eric Legault [MVP - Outlook]" wrote:

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...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" wrote:

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]" wrote:

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.

--
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" wrote:

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