• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1212
  • Last Modified:

Problem exporting Outlook Mailboxes to a text file using VBScript

I am trying to write a script to export the names and locations of any mailboxes a user has defined in Outlook to a text file.  This script would be run each time they logon to their computer.  The text file would contain entries in this format...

Mailbox - User, John Q
Exchange store
Personal Folders
C:\archive.PST

While we use Exchange, a lot of our users setup local PST files to archive old email.  When upgrading or re-imaging their computer, we would use this text file to make sure we transfer and reconnect any additional mailboxes.

I found and modified the code below and it works great as long as the user has an Outlook account defined.  To get the mailbox information, it looks like the script is actually (very quickly) opening and closing Outlook.  However, if the user doesn't have an Outlook account setup, they will get a generic Windows "Welcome to Outlook - Please setup you profile" dialog box.   This is a problem for two reasons.  First, we have a lot of users who move from one computer to another and we don't want this dialog box popping up whenever they logon to a new PC.  Second, we have a lot of users who don't have an email account at all so they would get this dialog prompt every time they logon to a computer.  

The problem appears to be with this line of code specifically...

For Each lo_folder In go_outlook.Session.Folders

How can I check if the user has an Outlook setup on that computer?  If they do, the script would run.  If not, the script would exit.   Alternatively, is there another way to accomplish the same goal?

Thanks!

'Turn on explicit variables
 Option Explicit
 
'Define Variables 
 
 Dim objFso, objShell, objFileHandle, BackupPath
 Dim go_fso, go_outlook, go_namespace 'go_ = Global Objects...
 Dim gl_folders, gl_files, gl_psts 'gl_ = Global Long integers
 Dim strMailBoxDataFileName
 
 Set objFso     =  wscript.CreateObject("scripting.filesystemobject")
 Set objShell   =  WScript.CreateObject("WScript.Shell")
 
 BackupPath = objShell.SpecialFolders("AppData")
 strMailBoxDataFileName = BackupPath & "\MailBox_Data.txt"
 
'Main Section
 
'Export Mailbox data to Mailbox_Data.txt 
 Call s_init()
 Call s_main()
 TerminateScript()
 
'Functions 
Sub s_init()
 Set go_fso = CreateObject( "Scripting.FileSystemObject" )
 Set go_outlook = CreateObject( "Outlook.Application" )
 Set go_namespace = go_outlook.GetNameSpace( "MAPI" )
End Sub
 
 
Sub s_main()
 Dim lo_folder, ls_path 'lo_ = Local Objects, 'ls_ = Local Strings...
 DIM objFSO, objTextFile
 
 Set objFSO = CreateObject("Scripting.FileSystemObject")
 Set objTextFile = objFSO.CreateTextFile( strMailBoxDataFileName )
 
 For Each lo_folder In go_outlook.Session.Folders
 
   On Error Resume Next
      ls_path = GetStorePath( lo_folder.StoreID )
   'Catch (and ignore) any errors
    If (Err.Number <> 0) Then
       On Error GoTo 0
    End If
    On Error GoTo 0
 
   
   objTextFile.Write( lo_folder.Name & vbCrLf)
   objTextFile.Write( ls_path & vbCrLf)
 Next
objTextFile.Close  
End Sub
 
 
Function GetStorePath(strStoreID)
 Dim intStart
 Dim intEnd
 Dim strProvider
 Dim strPathRaw
 
 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)
 Dim strTemp
 Dim strAll
 Dim i
 
 For i = 1 To Len(Data) Step 4
    strTemp = Mid(Data, i, 4)
    strTemp = "&H" & Right(strTemp, 2) & Left(strTemp, 2)
    strAll = strAll & ChrW(Eval(strTemp))
 Next
 Hex4ToString = strAll
End Function
 
Public Function Hex2ToString(Data)
 Dim strTemp
 Dim strAll
 Dim i
 
 For i = 1 To Len(Data) Step 2
    strTemp = "&H" & Mid(Data, i, 2)
    strAll = strAll & ChrW(Eval(strTemp))
 Next
 Hex2ToString = strAll
End Function 
 
 
 Function TerminateScript()
 wscript.quit
 End Function

Open in new window

0
HealthPartners
Asked:
HealthPartners
  • 3
  • 2
1 Solution
 
William ElliottSr Tech GuruCommented:
i would setup a prf file on the box and add it in the startup of the default users profile, this way when a user logs onto a box for the first time they have their profile autoconfigured for them.

how to create prf
http://office.microsoft.com/en-us/ork2003/HA011402581033.aspx

load the hive
c:\documents and setting\default user\ntuser.dat
using regedit.exe
and add this key

[HKEY_LOCAL_MACHINE\<default user profile>\Software\Microsoft\Windows\CurrentVersion\RunOnce]
"outlook"="outlook /importprf c:\\windows\\default.prf"
0
 
David LeeCommented:
Hi, HealthPartners.

I see two possible solutions to get this working.  First, instead of running this code from the login script, run it when Outlook launches.  That way it'll only run for staff who have an account and launch Outlook from a given computer.  Second, get Redemption (http://www.dimastr.com).  It'll give you the ability to check for an Outlook profile.  If one exists, then run the rest of the script.  If not, then do nothing.
0
 
HealthPartnersAuthor Commented:
I like the idea of running the script when Outlook is launched.  Not only would it solve both issues, it would be faster as well.  Instead of Outlook opening and closing at startup as well as when the user actually opened it themselves, it would only be opened once.

I've never done that before, how would you recommend doing it?  Does Outlook have an option to run a script upon startup?
0
Easily manage email signatures in Office 365

Managing email signatures in Office 365 can be a challenging task if you don't have the right tool. CodeTwo Email Signatures for Office 365 will help you implement a unified email signature look, no matter what email client is used by users. Test it for free!

 
David LeeCommented:
Outlook has an event that is triggered each time Outlook starts.  Actually, two events: Application_MAPILogonComplete and Application_Startup.  The former occurs when the user has logged into Outlook.  The latter occurs after Outlook has finished initializing, to include initializing all add-ins.  You could use either to run your code.  You could either insert all of your code in one of those event procedures or insert a command that calls your code.  I recommend the latter.  It'd allow you to keep the core code in a central location.  That would allow you to make changes to it and have those changes take effect immediately on all computers.  If you put the code in Outlook, then you'd have to modify the code on each computer.  

There is a downside to this approach.  Outlook does not have a means of distributing code.  The code will have to be manually added to each computer you want to run this on.  
Sub Application_Startup()
    'Your code or a call to your code goes here.
    Dim objShell As Object
    Set objShell = CreateObject("WScript.Shell")
    'Change the script name and path on the following line as needed
    objShell.Run "Cscript.exe C:\Some Folder\MyScript.vbs", 2, False
    Set objShell = Nothing
End Sub
 
or
 
Sub Application_MAPILogonComplete()
    'Same as above
End Sub

Open in new window

0
 
HealthPartnersAuthor Commented:
This is perfect, thanks for your help!
0
 
David LeeCommented:
You're welcome!
0

Featured Post

The new generation of project management tools

With monday.com’s project management tool, you can see what everyone on your team is working in a single glance. Its intuitive dashboards are customizable, so you can create systems that work for you.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now