Solved

Outlook Public Folder Favorites

Posted on 2012-03-23
10
2,589 Views
Last Modified: 2012-06-14
I have a client running Exchange 2010 with Outlook 2003, 2007, and 2010.  They have a Public Folder containing contact items, that they would like to automatically add to all users' favorites, so that it displays when they select "Contacts" from the Navigation Pane. Any ideas on where to begin on this?  I imagine I could create a Macro that would accomplish this?  Is there any way in Group Policy to accomplish this?  Any thoughts pointing me in the right direction would be much appreciated. Thanks everyone!
0
Comment
Question by:simpleworksit
  • 5
  • 5
10 Comments
 
LVL 76

Expert Comment

by:David Lee
ID: 37765097
I'm not aware of a group policy solution, but I'm not an expert on group policy.  Here's a macro-based solution I put together for another question: http://www.experts-exchange.com/Software/Internet_Email/Email/Email_Clients/Q_24429373.html
0
 

Author Comment

by:simpleworksit
ID: 37817516
I'm not sure what the difference between VBA and VBS is, but you mention you can make this work in VBS. Can you provide a script that works using VBS?
0
 
LVL 76

Expert Comment

by:David Lee
ID: 37825477
There are a number of differences between VBA (Visual Basic for Applications) and VBS (VBScript).  In this context the biggest difference is that VBA code has to be added to Outlook.  VBS runs from outside of Outlook.  I'll modify the code in the article I linked to so it runs under VBScript.
0
 
LVL 76

Accepted Solution

by:
David Lee earned 500 total points
ID: 37846756
This should do it.  Pay attention to the comments in the code.  To use this

1.  Open Notepad.
2.  Copy and paste the code into Notepad.
3.  Edit the code as needed.  I placed comments where things can/should change.
4.  Save the file with a .vbs extension.

You can test the script by double-clicking the file saved in step #4.  Once you've determined it is working the way you want it to you can add a call to it from a login script.  That will cause it to run for everyone thereby adding the favorite.

'Define some constants'
Const olMailModule = 158
Const olFavoriteFoldersGroup = 4
 
'Create some variables'
Dim olkApp, olkSes, olkPane, olkModule, olkGroup, olkFolder
 
'Connect to Outlook'
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon "Outlook"
 
'Get the Favorites group'
Set olkPane = olkApp.ActiveExplorer.NavigationPane
Set olkModule = olkPane.Modules.GetNavigationModule(olModuleMail)
Set olkGroup = olkModule.NavigationGroups.GetDefaultNavigationGroup(olFavoriteFoldersGroup)
 
'Get the folder to add'
Set olkFolder = OpenOutlookFolder("Projects\Domain Consolidation")    '<- change the folder path here'
'If this is a public folder, then add it to public folder favorites'
If InStr(1, olkFolder.FolderPath, "Public Folders") Then
    olkFolder.AddToPFFavorites
End If
 
'Add the folder to favorites'
olkGroup.NavigationFolders.Add olkFolder
 
'Clean-up'
Set olkPane = Nothing
Set olkModule = Nothing
Set olkGroup = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing
WScript.Quit
 
Function IsNothing(obj)
  If TypeName(obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function
 
Function OpenOutlookFolder(strFolderPath)
    Dim arrFolders, varFolder, olkMyFolder
    Set OpenOutlookFolder = Nothing
    Set olkMyFolder = Nothing
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            If IsNothing(olkMyFolder) Then
                Set olkMyFolder = olkSes.Folders(varFolder)
            Else
                Set olkMyFolder = olkMyFolder.Folders(varFolder)
            End If
        Next
        Set OpenOutlookFolder = olkMyFolder
    End If
    On Error Goto 0
End Function                                 

Open in new window

0
 

Author Comment

by:simpleworksit
ID: 37852221
Thank you so much. I will test this in a couple of days and let you know.
0
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 

Author Comment

by:simpleworksit
ID: 37887640
I tried using the script provided but I get an error on Line 26 character 1, so I put on Error Resume Next on line 24 and that resolved the error.  This works well on Outlook 2007, but in Outlook 2010 the path to the public folder is different.  

Ex.
Outlook 2007: ("\Public Folders\All Public Folders\Staff Contacts")
Outlook 2010: ("\Public Folders - user@domain.org\All Public Folders\Staff Contacts")

user@domain.org is different depending on the user's primary SMTP address.  I tried various things, as I was going to try to insert a variable SMTPAddress.  However, I am not confident enough with VBS scripts to create this variable. Also, I did some testing trying to put a variable in the folder path and it just calls the variables name due to the quotation marks.  I tried putting the quotation marks in various different places, but that doesn't appear to work either.
Ex. ("\Public Folders - user@domain.org"\"All Public Folders\Staff Contacts")
0
 
LVL 76

Expert Comment

by:David Lee
ID: 37940985
Can you share the line you used with the variable?
0
 

Author Comment

by:simpleworksit
ID: 37998787
Sorry for the delay, I have been on vacation.

This is what I have to get the email address, I can get it to echo the users' email address, but I cannot seem to assign this to a variable so that I can call it later in the script.


On Error Resume Next
Dim objSysInfo, objUser, objEmailAddress
Set objSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
Set objEmailAddress = objUser.EmailAddress
'the line below is for testing and doesn't display correctly with the above code
'WScript.Echo objEmailAddress

'if I use (below) it echos the user's email address correctly.
On Error Resume Next
Dim objSysInfo, objUser,
Set objSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
WScript.Echo objUser.EmailAddress
0
 
LVL 76

Assisted Solution

by:David Lee
David Lee earned 500 total points
ID: 38006332
No worries.  I hope you had a good time.

What we need to do is turn your code into a function that returns the user's address.  Here is that function.

Function GetAddress()
    On Error Resume Next
    Dim objSysInfo, objUser,
    Set objSysInfo = CreateObject("ADSystemInfo")
    Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
    GetAddress = objUser.EmailAddress 
End Function

Open in new window


We then modify line #19 of the original code to take a variable.  Here's the revised line #19.

Set olkFolder = OpenOutlookFolder("\Public Folders - " & GetUser() & "\All Public Folders\Staff Contacts")    '<- change the folder path here'

Open in new window

0
 

Author Closing Comment

by:simpleworksit
ID: 38085956
Thank you so much BlueDevil, I would never have been able to get this accomplished without your help.  I did have to do some additional modifications as I needed it to work for Outlook 2007 and Outlook 2010.  Also, the script throws errors and does not work unless Outlook is open, so I had to create a script that runs at login and watches for Outlook.exe process to spawn and then runs the script to add the folder to public folder favorites.

I have posted my scripts below.
RUN @ LOGIN AND CALLS PUBLICFOLDERS.VBS ON OUTLOOK OPENING
Set objShell = CreateObject("Wscript.Shell")

strComputer = "."

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")

Set colMonitoredProcesses = objWMIService. _        
    ExecNotificationQuery("Select * from __InstanceCreationEvent " _
        & " Within 1 Where TargetInstance ISA 'Win32_Process' AND " & _
            "TargetInstance.Name = 'Outlook.exe'")

Do While True
    Set objProcess = colMonitoredProcesses.NextEvent
    objShell.Run "C:\scripts\PublicFolders.vbs"
Loop
________________________________________________________________________________________
(PublicFolders.vbs) ADDS THE SAME PUBLIC FOLDER TO FAVORITES IN BOTH OUTLOOK 2007/2010
'Define some constants'
Const olMailModule = 158
Const olFavoriteFoldersGroup = 4

'Create some variables'
Dim olkApp, olkSes, olkPane, olkModule, olkGroup, olkFolder

'THIS SECTION IS FOR OUTLOOK 2010'
'Function to get email address"
Function GetAddress()
    On Error Resume Next
    Dim objSysInfo, objUser
    Set objSysInfo = CreateObject("ADSystemInfo")
    Set objUser = GetObject("LDAP://" & objSysInfo.UserName)
    GetAddress = objUser.EmailAddress
End Function

'Connect to Outlook'
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon "Outlook"
 
'Get the Favorites group'
Set olkPane = olkApp.ActiveExplorer.NavigationPane
Set olkModule = olkPane.Modules.GetNavigationModule(olModuleMail)
Set olkGroup = olkModule.NavigationGroups.GetDefaultNavigationGroup(olFavoriteFoldersGroup)
 
'Get the folder(s) to add'
Set olkFolder = OpenOutlookFolder("\Public Folders - " & GetAddress() & "\All Public Folders\FolderName")    '<- change the folder path here'
'If this is a public folder, then add it to public folder favorites'
 On Error Resume Next
If InStr(1, olkFolder.FolderPath, "Public Folders") Then
    olkFolder.AddToPFFavorites
End If
 On Error Resume Next
'Add the folder to favorites'
olkGroup.NavigationFolders.Add olkFolder
 On Error Goto 0

'THIS SECTION IS FOR OUTLOOK 2007"
'Connect to Outlook'
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNamespace("MAPI")
olkSes.Logon "Outlook"
 
'Get the Favorites group'
Set olkPane = olkApp.ActiveExplorer.NavigationPane
Set olkModule = olkPane.Modules.GetNavigationModule(olModuleMail)
Set olkGroup = olkModule.NavigationGroups.GetDefaultNavigationGroup(olFavoriteFoldersGroup)
 
'Get the folder(s) to add'
Set olkFolder = OpenOutlookFolder("\Public Folders\All Public Folders\FolderName")    '<- change the folder path here'
'If this is a public folder, then add it to public folder favorites'
 on Error Resume Next
If InStr(1, olkFolder.FolderPath, "Public Folders") Then
    olkFolder.AddToPFFavorites
End If
 On Error Resume Next
'Add the folder to favorites'
olkGroup.NavigationFolders.Add olkFolder
 On Error Goto 0
'Clean-up'
Set olkPane = Nothing
Set olkModule = Nothing
Set olkGroup = Nothing
olkSes.Logoff
Set olkSes = Nothing
Set olkApp = Nothing
WScript.Quit
 
Function IsNothing(obj)
  If TypeName(obj) = "Nothing" Then
    IsNothing = True
  Else
    IsNothing = False
  End If
End Function
 
Function OpenOutlookFolder(strFolderPath)
    Dim arrFolders, varFolder, olkMyFolder
    Set OpenOutlookFolder = Nothing
    Set olkMyFolder = Nothing
    On Error Resume Next
    If strFolderPath = "" Then
        Set OpenOutlookFolder = Nothing
    Else
        Do While Left(strFolderPath, 1) = "\"
            strFolderPath = Right(strFolderPath, Len(strFolderPath) - 1)
        Loop
        arrFolders = Split(strFolderPath, "\")
        For Each varFolder In arrFolders
            If IsNothing(olkMyFolder) Then
                Set olkMyFolder = olkSes.Folders(varFolder)
            Else
                Set olkMyFolder = olkMyFolder.Folders(varFolder)
            End If
        Next
        Set OpenOutlookFolder = olkMyFolder
    End If
    On Error Goto 0
End Function
0

Featured Post

What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

Join & Write a Comment

Resolve DNS query failed errors for Exchange
Not sure what the best email signature size is? Are you worried about email signature image size? Follow this best practice guide.
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

759 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

Need Help in Real-Time?

Connect with top rated Experts

22 Experts available now in Live!

Get 1:1 Help Now