+ Post New Thread
Results 1 to 2 of 2
Scripts Thread, VBS Script - OUTLOOK This script "adds to favorites" but can it "delete from Favs"? in Coding and Web Development; The following script below is used to add 5 public folders to everyones Outlook. All working well apart from it ...
  1. #1

    Join Date
    Aug 2007
    Posts
    812
    Thank Post
    98
    Thanked 64 Times in 46 Posts
    Rep Power
    26

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

    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)

    Code:
    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

  2. #2

    Join Date
    Aug 2007
    Posts
    812
    Thank Post
    98
    Thanked 64 Times in 46 Posts
    Rep Power
    26
    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!!

    Code:
    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

SHARE:
+ Post New Thread

Similar Threads

  1. Replies: 2
    Last Post: 21st November 2012, 04:02 PM
  2. Script to remove users from one group and add to another
    By JMBates in forum Windows Server 2000/2003
    Replies: 5
    Last Post: 11th April 2012, 10:02 AM
  3. Replies: 5
    Last Post: 11th April 2012, 10:02 AM
  4. Script Help - Query AD and add it to a reg key
    By Stuart_C in forum Scripts
    Replies: 6
    Last Post: 14th May 2010, 06:04 PM
  5. Unable to Send Email, but can receive it.
    By jmair in forum Internet Related/Filtering/Firewall
    Replies: 4
    Last Post: 27th February 2009, 11:59 AM

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •