Select current Outlook pst file

Hi, bt707.

To display the file names, make and return a  selection, you need to add a user form.  Modify the existing code to save the file names in an array or collection, then call the user form.  Code behind the form will read the values from the array/collection and display them on the form as whatever type of control you want (e.g. combobox, checkboxes, radio buttons, etc.)  The user makes a selection and the form returns that selection.  

For the issue of "Mailbox" in a name, use the InStr function.  Something like this

    If InStr(1,objFolder.Name,"Mailbox") Then
        'Skip the item
    Else
        'Code to process items that do not contain Mailbox in the folder name
    End If

Hi BlueDevilFan,

That worked great on the Mailbox issue, Thanks.

Not sure how to create a users form but have wanted to learn a bit on those, do you know of a good site to look at on getting started on that?

First thing I tried was to put them files found in a array like you said but not sure how. Can you show me how to put them in a array that will get me started with what I'm trying to do here.

very new to vb, have been doing some perl for awhile but now switching all of our servers to exchange from Sun servers so have to start learning more about vb to do what we need.

Thanks,

I modified it with your comments and now I just get the 3 file paths as I wanted, so just need to store them in a array for now.

Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
For Each objFolder In objNS.Folders
If InStr(1,objFolder.Name,"Mailbox") Then
        'Skip the item
    Else
        Wscript.Echo GetPSTPath(objFolder.StoreID)
    End If
Next
Function GetPSTPath(input)

   For i = 1 To Len(input) Step 2
       strSubString = Mid(input,i,2)        
       If Not strSubString = "00" Then
           strPath = strPath & ChrW("&H" & strSubString)
       End If
   Next
   
   Select Case True
       Case InStr(strPath,":\") > 0    
           GetPSTPath = Mid(strPath,InStr(strPath,":\")-1)
       Case InStr(strPath,"\\") > 0    
           GetPSTPath = Mid(strPath,InStr(strPath,"\\"))
   End Select
End Function


Thanks,

"That worked great on the Mailbox issue, Thanks."
You're welcome.

"do you know of a good site to look at on getting started on that?"
http://outlookcode.com is the best site for anything pertaining to Outlook development.  This is Sue Mosher's site, and she quite literally wrote the book on Outlook development.  Creating a user form is pretty simple stuff.  In Outlook's VB editor right-click on Forms in the project pane and select Insert > UserForm.  Place controls on the form and then write any code the form needs behind the form.

"Can you show me how to put them in a array that will get me started with what I'm trying to do here."
Sure.  I'd use a Collection instead of an Array because they're easier to grow and shrink.  The code would be something like this:

Dim colFolders As Collection, strPath As String
Set colFolders = New Collection
 
For Each objFolder In objNS.Folders
    If InStr(1, objFolder.Name, "Mailbox") Then
        'Do nothing'
    Else
        strPath = GetPSTPath(objFolder.StoreID)
        colFolders.Add strPath, strPath
    End If
Next

Select allOpen in new window

BlueDevilFan,

I'm doing something wrong, I've tried changing things but can't get it to work, I get a error on line 3, char 16 expecting end of statement, I tried putting in comas for the Dim line but then get other errors.

Also, once can put the files in the Collection, how can I view or store them?
Collection(0) ...(1) something like that or is that way off?

Thanks,



Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
Dim colFolders As Collection, strPath As String
Set colFolders = New Collection
 
For Each objFolder In objNS.Folders
    If InStr(1, objFolder.Name, "Mailbox") Then
        'Do nothing'
    Else
        strPath = GetPSTPath(objFolder.StoreID)
        colFolders.Add strPath, strPath
    End If
Next
Function GetPSTPath(input)

   For i = 1 To Len(input) Step 2
       strSubString = Mid(input,i,2)        
       If Not strSubString = "00" Then
           strPath = strPath & ChrW("&H" & strSubString)
       End If
   Next
   
   Select Case True
       Case InStr(strPath,":\") > 0    
           GetPSTPath = Mid(strPath,InStr(strPath,":\")-1)
       Case InStr(strPath,"\\") > 0    
           GetPSTPath = Mid(strPath,InStr(strPath,"\\"))
   End Select
End Function

"I get a error on line 3, char 16 expecting end of statement"
Did you copy that line in using copy and paste, or did you type it in?  If the former, try deleting the line and typing it in.  

"Collection(0) ...(1) something like that or is that way off?"
Close.  The way to access items in a collection is

   varSomething = CollectionName.Item(Index)

For example,

    colFolders.Item(1)

I tried pasting it in and typing it in but still get the same error.

Expected End of Statement.

I even tried putting it in like this.

Dim colFolders As Collection
Dim strPath As String

I updated my wscript a while back so not sure what it could be.

Thanks for the tip on the colFolders.Item(1), I just need to see why the collection will not go.

Are you doing this in Outlook or outside of Outlook using VBScript?  If the latter, then that's a problem.

Yes I just thought of that, I'm running it as a file.vbs script.

Is there a way to do that, once I get the rest of this script made I'll have a download for the users, so they can download it and run it, so would be hard to put into each of their Outlook profiles.

Thanks,

That's a problem.  VBScript doesn't have user forms.  There are only a couple of interface elements, MsgBox and InputBox.  MsgBox is strictly for displaying messages, InputBox only allows typing a value into a text box.  VBScript also requires switching from usig a collection to using a Dictionary object.  That's not a big deal.  The interface aspect is though.  About the only way to give VBScript an interface is to write the script as an HTML Application (.hta file).  

What's the ultimate goal?  If I knew that, then I might be able to suggest something.

I have a lot of users that need to split there pst files to smaller ones, I have a script I found on the web and modified it to where it all working now. However I don't want the users to have to run it by typing in the script.vbs date -- date-- path to pst - path to new pst

I've also modified it to where it gives a pop up  box to type in the start and end dates then saves those to a variable, the script I started with above will read in what ever pst files they have loaded in their Outlook, I just need a way for them to now select the one that will be used to be split. I have it to where I can echo out the 3 files and paths but I just need to be able to store each one of them in a variable or at least the one needed then I can make the script do everything else.

I could make a input box for them to type the full path in, but I have a large number of users and to many just can't figure that out. I have to make it where it's just one click and enter the dates they want and somehow enter or select which file.

Thanks for your help, I'm close to what I need if I could just store these 3 files in somehow.

Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
For Each objFolder In objNS.Folders
If InStr(1,objFolder.Name,"Mailbox") Then
        'Skip the item
    Else
        Wscript.Echo GetPSTPath(objFolder.StoreID)
    End If
Next
Function GetPSTPath(input)

   For i = 1 To Len(input) Step 2
       strSubString = Mid(input,i,2)        
       If Not strSubString = "00" Then
           strPath = strPath & ChrW("&H" & strSubString)
       End If
   Next
   
   Select Case True
       Case InStr(strPath,":\") > 0    
           GetPSTPath = Mid(strPath,InStr(strPath,":\")-1)
       Case InStr(strPath,"\\") > 0    
           GetPSTPath = Mid(strPath,InStr(strPath,"\\"))
   End Select
End Function


This script above will echo out the 3 files that are Open in Outlook in this case, but just one at a time using WScript.Echo

D:\outlook\files\outlook.pst
D:\outlook\files\2008.pst
D:\outlook\files\2007.pst


I guess I could write them (append) to a text file and then launch and open that, then have them copy and past or choose the one they want and enter it in inputbox, so far that's the only other idea I have.

Ok, try this revised version.  To use this, you'll also need to go to this page (http://www.robvanderwoude.com/vbstech_ui_userinput.html) and download the GetUserInput function (the bottom of the two code samples).  You'll want to edit that code by increasing the height and width of the box and changing the alignment of the body from centered to left.

Dim intCount, intChoice, strPath, arrPaths
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
For Each objFolder In objNS.Folders
    If InStr(1, objFolder.Name, "Mailbox") Then
        'Skip the item
    Else
        strPath = strPath & GetPSTPath(objFolder.StoreID) & "|"
    End If
Next
strPath = Left(strPath, (Len(strPath) - 1))
arrPaths = Split(strPath, "|")
strPath = ""
For intCount = LBound(arrPaths) To UBound(arrPaths)
    strPath = strPath & (intCount + 1) & ": " & arrPaths(intCount) & "<br>"
Next
intChoice = GetUserInput("Enter the number of the folder to process" & "<br><br>" & strPath)
If IsNumeric(intChoice) Then
    intChoice = intChoice - 1
    If (intChoice >= LBound(arrPaths)) And (intChoice <= UBound(arrPaths)) Then
        strPath = arrPaths(intChoice)
        'Code for whatever it is you need to do with the chosen folder'
    End If
End If
 
Function GetPSTPath(input)
   For i = 1 To Len(input) Step 2
       strSubString = Mid(input,i,2)        
       If Not strSubString = "00" Then
           strPath = strPath & ChrW("&H" & strSubString)
       End If
   Next
   
   Select Case True
       Case InStr(strPath,":\") > 0    
           GetPSTPath = Mid(strPath,InStr(strPath,":\")-1)
       Case InStr(strPath,"\\") > 0    
           GetPSTPath = Mid(strPath,InStr(strPath,"\\"))
   End Select
End Function

Select allOpen in new window

BlueDevilFan,

May just work but getting some garbage output. I attached a screen shot of what it looks like. The text is all messed up but I can still select a number. After I do select a number it dies, what does that selection do, does it store it somewhere?

Thanks a lot for all your help, see screen shot.
select.jpg

I found what you did and got the output of the directory it selected, this would be perfect, only issue now is I'm getting a messed up text in the path. The path is there it's just messed up with a lot of other garbage text.

I don't know where the garbage text is coming from.  I ran the same code here and the text looks perfect.

If I select #1 it comes out as this in the screen shot.

So good if could just get the correct format of the text.
img2.gif

That's strange, well if it worked on yours then something not right here, trying to see what it is.

Maybe I did something wrong, I did have to comment out the line -- objIE.Document.Title = "Input Required"
to get it to run, just got errors on that line, but can't see why that would matter, it runs fine with that commented out but get the garbage.

Here is what I ran, if you see anything I did wrong.


strUserInput = GetUserInput( "Please enter your name:" )
WScript.Echo "Your name is: " & strUserInput
Function GetUserInput( myPrompt )
' This function uses Internet Explorer to
' create a dialog and prompt for user input.
'
' Argument:   [string] prompt text, e.g. "Please enter your name:"
' Returns:    [string] the user input typed in the dialog screen
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
    Dim objIE
    ' Create an IE object
    Set objIE = CreateObject( "InternetExplorer.Application" )
    ' specify some of the IE window's settings
    objIE.Navigate "about:blank"
'''''    objIE.Document.Title = "Input Required"
    objIE.ToolBar        = False
    objIE.Resizable      = False
    objIE.StatusBar      = False
    objIE.Width          = 1200
    objIE.Height         = 700
    ' Center the dialog window on the screen
    With objIE.Document.ParentWindow.Screen
        objIE.Left = (.AvailWidth  - objIE.Width ) \ 2
        objIE.Top  = (.Availheight - objIE.Height) \ 2
    End With
    ' Wait till IE is ready
    Do While objIE.Busy
        WScript.Sleep 200
    Loop
    ' Insert the HTML code to prompt for user input
    objIE.Document.Body.InnerHTML = "<DIV align=""center""><P>" & myPrompt _
                                  & "</P>" & vbCrLf _
                                  & "<P><INPUT TYPE=""text"" SIZE=""20"" " _
                                  & "ID=""UserInput""></P>" & vbCrLf _
                                  & "<P><INPUT TYPE=""hidden"" ID=""OK"" " _
                                  & "NAME=""OK"" VALUE=""0"">" _
                                  & "<INPUT TYPE=""submit"" VALUE="" OK "" " _
                                  & "OnClick=""VBScript:OK.Value=1""></P></DIV>"
    ' Make the window visible
    objIE.Visible = True
    ' Wait till the OK button has been clicked
    Do While objIE.Document.All.OK.Value = 0
        WScript.Sleep 200
    Loop
    ' Read the user input from the dialog window
    GetUserInput = objIE.Document.All.UserInput.Value
    ' Close and release the object
    objIE.Quit
    Set objIE = Nothing
End Function


Dim intCount, intChoice, strPath, arrPaths
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
For Each objFolder In objNS.Folders
    If InStr(1, objFolder.Name, "Mailbox") Then
        'Skip the item
    Else
        strPath = strPath & GetPSTPath(objFolder.StoreID) & "|"
    End If
Next
strPath = Left(strPath, (Len(strPath) - 1))
arrPaths = Split(strPath, "|")
strPath = ""
For intCount = LBound(arrPaths) To UBound(arrPaths)
    strPath = strPath & (intCount + 1) & ": " & arrPaths(intCount) & "<br>"
Next
intChoice = GetUserInput("Enter the number of the folder to process" & "<br><br>" & strPath)
If IsNumeric(intChoice) Then
    intChoice = intChoice - 1
    If (intChoice >= LBound(arrPaths)) And (intChoice <= UBound(arrPaths)) Then
        strPath = arrPaths(intChoice)
        'Code for whatever it is you need to do with the chosen folder'
WScript.Echo "This is it " & arrPaths(intChoice)


    End If
End If
 
Function GetPSTPath(input)
   For i = 1 To Len(input) Step 2
       strSubString = Mid(input,i,2)        
       If Not strSubString = "00" Then
           strPath = strPath & ChrW("&H" & strSubString)
       End If
   Next
   
   Select Case True
       Case InStr(strPath,":\") > 0    
           GetPSTPath = Mid(strPath,InStr(strPath,":\")-1)
       Case InStr(strPath,"\\") > 0    
           GetPSTPath = Mid(strPath,InStr(strPath,"\\"))
   End Select
End Function

Take out the first two lines.  Also, the GetUserInput function should be below everything else.

I still get the same garbage, I just don't see why.
img4.gif

Yours sure came out perfect, I have IE 7 so can't see that being a issue I don't think. The text on mine comes out fine for the "Enter the number of folder to process" but then the file paths are a mess.

Oh well Thanks for all your help, you gave me some good ideas and it's working fine on your for some reason not mine. Thank you so much for all of your help, I'll go ahead and accept this and see if I can get it to sort out some how.

If you can past the script as you ran it, maybe if I copy it from your it will work here.

Thanks again!!!

Here's code as I have it.  

You're welcome.  Glad I could help.

Dim intCount, intChoice, strPath, arrPaths
Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
For Each objFolder In objNS.Folders
    If InStr(1, objFolder.Name, "Mailbox") Then
        'Skip the item
    Else
        strPath = strPath & GetPSTPath(objFolder.StoreID) & "|"
    End If
Next
strPath = Left(strPath, (Len(strPath) - 1))
arrPaths = Split(strPath, "|")
strPath = ""
For intCount = LBound(arrPaths) To UBound(arrPaths)
    strPath = strPath & (intCount + 1) & ": " & arrPaths(intCount) & "<br>"
Next
intChoice = GetUserInput("Enter the number of the folder to process" & "<br>" & strPath)
If IsNumeric(intChoice) Then
    intChoice = intChoice - 1
    If (intChoice >= LBound(arrPaths)) And (intChoice <= UBound(arrPaths)) Then
        strPath = arrPaths(intChoice)
        'Code for whatever it is you need to do with the chosen folder'
    End If
End If
WScript.Quit
 
Function GetPSTPath(myinput)
   For i = 1 To Len(myinput) Step 2
       strSubString = Mid(myinput, i, 2)
       If Not strSubString = "00" Then
           strPath = strPath & ChrW("&H" & strSubString)
       End If
   Next
   
   Select Case True
       Case InStr(strPath, ":\") > 0
           GetPSTPath = Mid(strPath, InStr(strPath, ":\") - 1)
       Case InStr(strPath, "\\") > 0
           GetPSTPath = Mid(strPath, InStr(strPath, "\\"))
   End Select
End Function
 
'This function is not my code.  It comes from this page http://www.robvanderwoude.com/vbstech_ui_userinput.html'
Function GetUserInput(myPrompt)
' This function uses Internet Explorer to
' create a dialog and prompt for user input.
'
' Argument:   [string] prompt text, e.g. "Please enter your name:"
' Returns:    [string] the user input typed in the dialog screen
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
    Dim objIE
    ' Create an IE object
    Set objIE = CreateObject("InternetExplorer.Application")
    ' specify some of the IE window's settings
    objIE.navigate "about:blank"
    objIE.Document.Title = "Input required"
    objIE.Toolbar = False
    objIE.resizable = False
    objIE.StatusBar = False
    objIE.Width = 800
    objIE.Height = 400
    ' Center the dialog window on the screen
    With objIE.Document.parentWindow.screen
        objIE.Left = (.availWidth - objIE.Width) \ 2
        objIE.Top = (.availHeight - objIE.Height) \ 2
    End With
    ' Wait till IE is ready
    Do While objIE.Busy
        wscript.Sleep 200
    Loop
    ' Insert the HTML code to prompt for user input
    objIE.Document.Body.innerHTML = "<DIV align=""left""><P>" & myPrompt _
                                  & "</P>" & vbCrLf _
                                  & "<P><INPUT TYPE=""text"" SIZE=""20"" " _
                                  & "ID=""UserInput""></P>" & vbCrLf _
                                  & "<P><INPUT TYPE=""hidden"" ID=""OK"" " _
                                  & "NAME=""OK"" VALUE=""0"">" _
                                  & "<INPUT TYPE=""submit"" VALUE="" OK "" " _
                                  & "OnClick=""VBScript:OK.Value=1""></P></DIV>"
    ' Make the window visible
    objIE.Visible = True
    ' Wait till the OK button has been clicked
    Do While objIE.Document.all.OK.Value = 0
        wscript.Sleep 200
    Loop
    ' Read the user input from the dialog window
    GetUserInput = objIE.Document.all.UserInput.Value
    ' Close and release the object
    objIE.Quit
    Set objIE = Nothing
End Function

Select allOpen in new window