?
Solved

Select current Outlook pst file

Posted on 2008-11-09
24
Medium Priority
?
321 Views
Last Modified: 2012-05-05
I have a script that finds what pst files are currently being used in Outlook and for now echos the file and path out.

_____________________________________________________________________

Set objOutlook = CreateObject("Outlook.Application")
Set objNS = objOutlook.GetNamespace("MAPI")
 
For Each objFolder In objNS.Folders
If objFolder.Name <> "Mailbox" Then
       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

_____________________________________________________________________

Example: If I have 3 pst files open right now in Outlook I will get 3 message boxes such as

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


What I want to do is to create a case for the files found (in this case the 3 files found)
Then have a message box that I can list the 3 files found and select the one I want which will then store
that file path in a varible. So If I was to slect "D:\outlook\files\2008.pst" then in my script I could use
OutLookfile = "D:\outlook\files\2008.pst"

One other issue I have is this line ''''If objFolder.Name <> "Mailbox" Then
not a big deal but the Outlook .ost file is always named like "Mailbox - John Doe"
I do not want it to read this one, I've tried using a wildcare here but that cannot be done.
How can I match any name other than "Mailbox - some name"


Thanks for any help on this.





0
Comment
Question by:bt707
  • 14
  • 10
24 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 22916943
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
0
 

Author Comment

by:bt707
ID: 22916990
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,

0
 

Author Comment

by:bt707
ID: 22917003
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,
0
Windows Server 2016: All you need to know

Learn about Hyper-V features that increase functionality and usability of Microsoft Windows Server 2016. Also, throughout this eBook, you’ll find some basic PowerShell examples that will help you leverage the scripts in your environments!

 
LVL 76

Expert Comment

by:David Lee
ID: 22917042
"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

Open in new window

0
 

Author Comment

by:bt707
ID: 22917140
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
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22917219
"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)
0
 

Author Comment

by:bt707
ID: 22917254
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.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22917307
Are you doing this in Outlook or outside of Outlook using VBScript?  If the latter, then that's a problem.
0
 

Author Comment

by:bt707
ID: 22917317
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,

0
 
LVL 76

Expert Comment

by:David Lee
ID: 22917360
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.
0
 

Author Comment

by:bt707
ID: 22917385
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.
0
 

Author Comment

by:bt707
ID: 22917429
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.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22917845
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

Open in new window

0
 

Author Comment

by:bt707
ID: 22917981
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
0
 

Author Comment

by:bt707
ID: 22918004
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.
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22918065
I don't know where the garbage text is coming from.  I ran the same code here and the text looks perfect.
0
 

Author Comment

by:bt707
ID: 22918068
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
0
 

Author Comment

by:bt707
ID: 22918072
That's strange, well if it worked on yours then something not right here, trying to see what it is.
0
 

Author Comment

by:bt707
ID: 22918083
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
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22918096
Take out the first two lines.  Also, the GetUserInput function should be below everything else.
0
 

Author Comment

by:bt707
ID: 22918134
I still get the same garbage, I just don't see why.
img4.gif
0
 
LVL 76

Accepted Solution

by:
David Lee earned 2000 total points
ID: 22918211
Don't know.  Here's what it looks like at my end.
Screenshot.jpg
0
 

Author Comment

by:bt707
ID: 22918225
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!!!
0
 
LVL 76

Expert Comment

by:David Lee
ID: 22918243
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

Open in new window

0

Featured Post

Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

Question has a verified solution.

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

This article describes how to import Lotus Notes Contacts into Outlook 2016, 2013, 2010 and 2007 etc. with a few manual steps. You can easily export and migrate Lotus Notes contacts into Microsoft Outlook without having to use any third party tools.
Are you looking for the options available for exporting EDB files to PST? You may be confused as they are different in different Exchange versions. Here, I will discuss some options available.
This is my first video review of Microsoft Bookings, I will be doing a part two with a bit more information, but wanted to get this out to you folks.
As many of you are aware about Scanpst.exe utility which is owned by Microsoft itself to repair inaccessible or damaged PST files, but the question is do you really think Scanpst.exe is capable to repair all sorts of PST related corruption issues?
Suggested Courses

755 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