Jump to content

VBS Script - OUTLOOK This script "adds to favorites" but can it "delete from Favs"?


Recommended Posts

Posted

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

Posted

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

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 account

Sign in

Already have an account? Sign in here.

Sign In Now



×
×
  • Create New...