如何设置 Outlook 文件夹的自定义图标? [英] How to set a custom Icon of an Outlook folder?

问题描述

有没有办法使用 Outlook 对象模型设置 Outlook 文件夹或子文件夹的自定义图标?

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

推荐答案

从 Outlook 2010 开始，您可以使用如上所述的 MAPIFolder.SetCUstomIcon.

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

我最近遇到了同样的挑战，并在以下位置找到了一段不错的 VBA 代码片段可以更改 Outlook 文件夹的颜色吗?:

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

joelandre _{2015 年 1 月 12 日晚上 9:13}

1. 将文件 icons.zip 解压到 C:图标
2. 将下面的代码定义为 Visual Basic 宏

3. 根据您的需要调整函数 ColorizeOutlookFolders 文本

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("\PersonalDocuments00-Mgmt-CH100-People", "blue")
    Call ColorizeFolderAndSubFolders("\PersonalDocuments00-Mgmt-CH200-Projects","red")
    Call ColorizeFolderAndSubFolders("\PersonalDocuments00-Mgmt-CH500-Meeting", "green")
    Call ColorizeFolderAndSubFolders("\PersonalDocuments00-Mgmt-CH800-Product", "magenta")
    Call ColorizeFolderAndSubFolders("\PersonalDocuments00-Mgmt-CH600-Departments", "grey")

    Call ColorizeFolderAndSubFolders("\Mailbox - Dan WilsonInboxCustomers", "grey")


End Sub

在对象ThisOutlookSession中，定义如下函数:

In the object ThisOutlookSession, define the following function:

Private Sub Application_Startup()

ColorizeOutlookFolders

End Sub

和

为了不给子文件夹着色，您可以使用该功能ColorizeOneFolder 而不是 ColorizeFolderAndSubFolders 例如

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

Sub ColorizeOutlookFolders()

    Call ColorizeOneFolder ("\PersonalDocuments00-Mgmt-CH100-People", "blue")
    Call ColorizeOneFolder ("\PersonalDocuments00-Mgmt-CH200-Projects", "red")
    Call ColorizeOneFolder ("\PersonalDocuments00-Mgmt-CH500-Meeting", "green")
    Call ColorizeOneFolder ("\PersonalDocuments00-Mgmt-CH800-Product", "magenta")
    Call ColorizeOneFolder ("\PersonalDocuments00-Mgmt-CH600-Departments", "grey")

    Call ColorizeOneFolder ("\Mailbox - Dan WilsonInboxCustomers", "grey")

End Sub

当您在文件夹之间移动子文件夹时，它们应该保留其直到下次重新启动 Outlook 时才着色.

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

这篇关于如何设置 Outlook 文件夹的自定义图标?的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！