simpleworksit
asked on
Outlook Public Folder Favorites
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!
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: https://www.experts-exchange.com/questions/24429373/Is-there-a-way-to-create-a-shortut-to-a-public-folder-in-Outlook-2007.html
ASKER
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?
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.
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thank you so much. I will test this in a couple of days and let you know.
ASKER
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")
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")
Can you share the line you used with the variable?
ASKER
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
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
SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
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.Shel l")
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colMonitoredProcesses = objWMIService. _
ExecNotificationQuery("Sel ect * from __InstanceCreationEvent " _
& " Within 1 Where TargetInstance ISA 'Win32_Process' AND " & _
"TargetInstance.Name = 'Outlook.exe'")
Do While True
Set objProcess = colMonitoredProcesses.Next Event
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.Appl ication")
Set olkSes = olkApp.GetNamespace("MAPI" )
olkSes.Logon "Outlook"
'Get the Favorites group'
Set olkPane = olkApp.ActiveExplorer.Navi gationPane
Set olkModule = olkPane.Modules.GetNavigat ionModule( olModuleMa il)
Set olkGroup = olkModule.NavigationGroups .GetDefaul tNavigatio nGroup(olF avoriteFol dersGroup)
'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.Appl ication")
Set olkSes = olkApp.GetNamespace("MAPI" )
olkSes.Logon "Outlook"
'Get the Favorites group'
Set olkPane = olkApp.ActiveExplorer.Navi gationPane
Set olkModule = olkPane.Modules.GetNavigat ionModule( olModuleMa il)
Set olkGroup = olkModule.NavigationGroups .GetDefaul tNavigatio nGroup(olF avoriteFol dersGroup)
'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(strFolde rPath)
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(varFol der)
End If
Next
Set OpenOutlookFolder = olkMyFolder
End If
On Error Goto 0
End Function
I have posted my scripts below.
RUN @ LOGIN AND CALLS PUBLICFOLDERS.VBS ON OUTLOOK OPENING
Set objShell = CreateObject("Wscript.Shel
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colMonitoredProcesses = objWMIService. _
ExecNotificationQuery("Sel
& " Within 1 Where TargetInstance ISA 'Win32_Process' AND " & _
"TargetInstance.Name = 'Outlook.exe'")
Do While True
Set objProcess = colMonitoredProcesses.Next
objShell.Run "C:\scripts\PublicFolders.
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.Appl
Set olkSes = olkApp.GetNamespace("MAPI"
olkSes.Logon "Outlook"
'Get the Favorites group'
Set olkPane = olkApp.ActiveExplorer.Navi
Set olkModule = olkPane.Modules.GetNavigat
Set olkGroup = olkModule.NavigationGroups
'Get the folder(s) to add'
Set olkFolder = OpenOutlookFolder("\Public
'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
On Error Goto 0
'THIS SECTION IS FOR OUTLOOK 2007"
'Connect to Outlook'
Set olkApp = CreateObject("Outlook.Appl
Set olkSes = olkApp.GetNamespace("MAPI"
olkSes.Logon "Outlook"
'Get the Favorites group'
Set olkPane = olkApp.ActiveExplorer.Navi
Set olkModule = olkPane.Modules.GetNavigat
Set olkGroup = olkModule.NavigationGroups
'Get the folder(s) to add'
Set olkFolder = OpenOutlookFolder("\Public
'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
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(strFolde
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(varFol
End If
Next
Set OpenOutlookFolder = olkMyFolder
End If
On Error Goto 0
End Function