burgemaster Posted November 22, 2012 Posted November 22, 2012 The following script below is used to add 5 public folders to everyones Outlook. All working well apart from it has been requested that the three default folder "Inbox,Unread Mail, Sent Mail" be removed from this list? Looking and searching I am hoping that the command is DeleteFavoriteFolder but im un-sure? was hoping something as simple as: DeleteFavoriteFolder = "Inbox" but my limited coding skills have failed. Can anyone please assist? (Script only works with Outlook 2007, i have a 2010 script if you require) 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("Head's Notices") olkFolder.AddToPFFavorites Set olkFolder = olkSes.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Daily Bulletin") olkFolder.AddToPFFavorites Set olkFolder = olkSes.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Weekly Tutor Focus") olkFolder.AddToPFFavorites Set olkFolder = olkSes.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Rewards & Sanctions") olkFolder.AddToPFFavorites Set olkFolder = olkSes.GetDefaultFolder(olPublicFoldersAllPublicFolders).Folders("Urgent Staff Notices") 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\Head's Notices") AddFavoriteFolder olkFolder Set olkFolder = OpenOutlookFolder("Public Folders\Favorites\Weekly Tutor Focus") AddFavoriteFolder olkFolder Set olkFolder = OpenOutlookFolder("Public Folders\Favorites\Daily Bulletin") AddFavoriteFolder olkFolder Set olkFolder = OpenOutlookFolder("Public Folders\Favorites\Rewards & Sanctions") AddFavoriteFolder olkFolder Set olkFolder = OpenOutlookFolder("Public Folders\Favorites\Urgent Staff Notices") 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
burgemaster Posted November 22, 2012 Author Posted November 22, 2012 ive patched together a VB MACRO to do this through running it in outlook... If anyone can please convert it to a VB Script that would be amazing!! Sub RemoveDeadFolders() 'Edit the folder names. Add more folder names as needed.' RemoveFavoriteFolder "Inbox" RemoveFavoriteFolder "Unread Mail" RemoveFavoriteFolder "Sent Items" End Sub Sub RemoveFavoriteFolder(strFolderName As String) ' Purpose: Add a folder to Favorite Folders.' ' Written: 6/18/2009' ' Author: BlueDevilFan' ' Outlook: 2007' Dim olkPane As Object, _ olkModule As Object, _ olkGroup As Object Set olkPane = Outlook.Application.ActiveExplorer.NavigationPane Set olkModule = olkPane.Modules.GetNavigationModule(olModuleMail) Set olkGroup = olkModule.NavigationGroups.GetDefaultNavigationGroup(olFavoriteFoldersGroup) olkGroup.NavigationFolders.Remove olkGroup.NavigationFolders.Item(strFolderName) Set olkPane = Nothing Set olkModule = Nothing Set olkGroup = Nothing End Sub Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean) End Sub
Recommended Posts
Create an account or sign in to comment
You need to be a member in order to leave a comment
Create an account
Sign up for a new account in our community. It's easy!
Register a new accountSign in
Already have an account? Sign in here.
Sign In Now