How to automate the process to show my public folder calender in Mail Favorite folder?

I wanted to do it either by login script or by group policy.

I am using Microsoft Exchange server 2007 with Windows Server 2008 R2 and Domain controller running Windows Server 2003 R2.

All workstation system have either Outlook 2010 or Outlook 2007.

While searching on this I found the script below, but by this script (already modified the path) I am just able to make public folder calender to show in public folder favorite but not in mail favorite folder.







"Const olPublicFoldersAllPublicFolders = 18
Dim olkApp, olkSes, olkFolder
Set olkApp = CreateObject("Outlook.Application")
Set olkSes = olkApp.GetNameSpace("MAPI")
'Change the profile name on the next line'
olkSes.Logon "Outlook"
'Change the folder name on the next line. Repeat the next two lines for each folder
you want to add.'
Set olkFolder =
olkSes.GetDefaultFolder(olPublicFoldersAllPublicFo lders).Folders("Public
calender").Folders("p cal")
olkFolder.AddToPFFavorites
'Change the folder name on the next line. Repeat the next two lines for each folder
you want to add.'
Set olkFolder = OpenOutlookFolder("Public Folders\Favorites\P cal")
AddFavoriteFolder olkFolder
olkSes.Logoff
Set olkApp = Nothing
Set olkSes = Nothing
Set olkFolder = Nothing
WScript.Quit

Sub AddFavoriteFolder(olkFolder)
' Purpose: Add a folder to Favorite Folders.'
' Written: 5/2/2009'
' Author: BlueDevilFan'
' Outlook: 2007'
Const olModuleMail = 0
Const olFavoriteFoldersGroup = 4
Dim olkPane, olkModule, olkGroup
Set olkPane = olkApp.ActiveExplorer.NavigationPane
Set olkModule = olkPane.Modules.GetNavigationModule(olModuleMail)
Set olkGroup =
olkModule.NavigationGroups.GetDefaultNavigationGro up(olFavoriteFoldersGroup)
olkGroup.NavigationFolders.Add olkFolder
Set olkPane = Nothing
Set olkModule = Nothing
Set olkGroup = Nothing
End Sub

Function OpenOutlookFolder(strFolderPath)
' Purpose: Opens an Outlook folder from a folder path.'
' Written: 4/24/2009'
' Author: BlueDevilFan'
' Outlook: All versions'
Dim arrFolders, varFolder, bolBeyondRoot
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
Select Case bolBeyondRoot
Case False
Set OpenOutlookFolder = olkSes.Folders(varFolder)
bolBeyondRoot = True
Case True
Set OpenOutlookFolder = OpenOutlookFolder.Folders(varFolder)
End Select
If Err.Number 0 Then
Set OpenOutlookFolder = Nothing
Exit For
End If
Next
End If
On Error GoTo 0
End Function "