How to set a custom Icon of an Outlook folder?

m23 picture m23 · Jan 10, 2010 · Viewed 8.8k times · Source

Is there any way to set a custom Icon of an Outlook folder or subfolder using Outlook object model?

Answer

Stefan picture Stefan · Aug 12, 2015

As from Outlook 2010 you can use MAPIFolder.SetCUstomIcon as described above.

I have had the same challenge recently and found a nice snippet of VBA code at Change Outlook folders colors possible?:

joelandre Jan 12, 2015 at 9:13 PM

  1. Unzip the file icons.zip to C:\icons
  2. Define the code below as Visual Basic Macros
  3. Adapt the function ColorizeOutlookFolders according to your needs Text

    Function GetFolder(ByVal FolderPath As String) As Outlook.folder
        ' Returns an Outlook folder object basing on the folder path
        '
        Dim TempFolder As Outlook.folder
        Dim FoldersArray As Variant
        Dim i As Integer
    
        On Error GoTo GetFolder_Error
    
        'Remove Leading slashes in the folder path
        If Left(FolderPath, 2) = "\\" Then
            FolderPath = Right(FolderPath, Len(FolderPath) - 2)
        End If
    
        'Convert folderpath to array
        FoldersArray = Split(FolderPath, "\")
        Set TempFolder = Application.Session.Folders.Item(FoldersArray(0))
    
        If Not TempFolder Is Nothing Then
            For i = 1 To UBound(FoldersArray, 1)
                Dim SubFolders As Outlook.Folders
                Set SubFolders = TempFolder.Folders
                Set TempFolder = SubFolders.Item(FoldersArray(i))
                If TempFolder Is Nothing Then
                    Set GetFolder = Nothing
                End If
            Next
        End If
        'Return the TempFolder
        Set GetFolder = TempFolder
        Exit Function   GetFolder_Error:
        Set GetFolder = Nothing
        Exit Function End Function   Sub ColorizeOneFolder(FolderPath As String, FolderColour As String)
        Dim myPic As IPictureDisp
        Dim folder As Outlook.folder
    
        Set folder = GetFolder(FolderPath)
        Set myPic = LoadPicture("C:\icons\" + FolderColour + ".ico")
        If Not (folder Is Nothing) Then
            ' set a custom icon to the folder
            folder.SetCustomIcon myPic
            'Debug.Print "setting colour to " + FolderPath + " as " + FolderColour
        End If End Sub
    
    Sub ColorizeFolderAndSubFolders(strFolderPath As String, strFolderColour As String)
        ' this procedure colorizes the foler given by strFolderPath and all subfolfers
    
        Dim olProjectRootFolder As Outlook.folder
        Set olProjectRootFolder = GetFolder(strFolderPath)
    
        Dim i As Long
        Dim olNewFolder As Outlook.MAPIFolder
        Dim olTempFolder As Outlook.MAPIFolder
        Dim strTempFolderPath As String
    
        ' colorize folder
        Call ColorizeOneFolder(strFolderPath, strFolderColour)
    
         ' Loop through the items in the current folder.
        For i = olProjectRootFolder.Folders.Count To 1 Step -1
    
            Set olTempFolder = olProjectRootFolder.Folders(i)
    
            strTempFolderPath = olTempFolder.FolderPath
    
             'prints the folder path and name in the VB Editor's Immediate window
             'Debug.Print sTempFolderPath
    
             ' colorize folder
             Call ColorizeOneFolder(strTempFolderPath, strFolderColour)
        Next
    
        For Each olNewFolder In olProjectRootFolder.Folders
            ' recursive call
            'Debug.Print olNewFolder.FolderPath
            Call ColorizeFolderAndSubFolders(olNewFolder.FolderPath, strFolderColour)
        Next
    
    End Sub
    
    Sub ColorizeOutlookFolders()
    
        Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\100-People", "blue")
        Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\200-Projects","red")
        Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\500-Meeting", "green")
        Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\800-Product", "magenta")
        Call ColorizeFolderAndSubFolders("\\Personal\Documents\000-Mgmt-CH\600-Departments", "grey")
    
        Call ColorizeFolderAndSubFolders("\\Mailbox - Dan Wilson\Inbox\Customers", "grey")
    
    
    End Sub
    
  4. In the object ThisOutlookSession, define the following function:

    Private Sub Application_Startup()
    
    ColorizeOutlookFolders
    
    End Sub
    

and

In order to NOT color sub-folders, you can use the function ColorizeOneFolder instead of ColorizeFolderAndSubFolders e.g.

Sub ColorizeOutlookFolders()

    Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\100-People", "blue")
    Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\200-Projects", "red")
    Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\500-Meeting", "green")
    Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\800-Product", "magenta")
    Call ColorizeOneFolder ("\\Personal\Documents\000-Mgmt-CH\600-Departments", "grey")

    Call ColorizeOneFolder ("\\Mailbox - Dan Wilson\Inbox\Customers", "grey")

End Sub

When you move sub-folders between folders, they should retain their color only until the next time you restart Outlook.