Script for showing Public Folder Calender to Main Mail Favorite f

[Sainyam]

Hello,

Can we automate the process of showing public folder calender to mail favorite folder.

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 a login 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(olPublicFoldersAllPublicFolders).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.GetDefaultNavigationGroup(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

I am new for VB script but tried to modified it for achieving my target but no luck!!

this is my public folder

wanted to show here