当前位置：文江博客话题详情

如何设置Outlook文件夹的自定义图标？

发布于 2024-08-17 07:34:31 字数 53 浏览 2 评论 0原文

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

原文

分享到QQ

分享到微博

如果你对这篇内容有疑问，欢迎到本站社区发帖提问参与讨论，获取更多帮助，或者扫码二维码加入 Web 技术交流群。

发布评论

需要登录才能够评论，你可以免费注册一个本站的账号。

微暖i 2024-08-24 07:34:31

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

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

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

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

根据您的需要调整 ColorizeOutlookFolders 函数 Text

函数 GetFolder(ByVal FolderPath As String) As Outlook.folder
    ' 根据文件夹路径返回 Outlook 文件夹对象
    '
    将 TempFolder 调暗为 Outlook.folder
    暗淡文件夹数组作为变体
    将 i 调暗为整数

    出错时转到 GetFolder_Error

    '删除文件夹路径中的前导斜杠
    如果 Left(FolderPath, 2) = "\\" 那么
        文件夹路径 = Right(文件夹路径, Len(文件夹路径) - 2)
    结束如果

    '将文件夹路径转换为数组
    FoldersArray = Split(FolderPath, "\")
    设置 TempFolder = Application.Session.Folders.Item(FoldersArray(0))

    如果不是 TempFolder 那么什么都不是
        对于 i = 1 到 UBound(FoldersArray, 1)
            将子文件夹变暗为 Outlook.Folders
            设置子文件夹 = TempFolder.Folders
            设置 TempFolder = SubFolders.Item(FoldersArray(i))
            如果 TempFolder 什么都没有那么
                设置 GetFolder = 无
            结束如果
        下一个
    结束如果
    '返回临时文件夹
    设置 GetFolder = 临时文件夹
    退出函数 GetFolder_Error：
    设置 GetFolder = 无
    退出函数结束函数 Sub ColorizeOneFolder（FolderPath As String，FolderColour As String）
    将 myPic 调暗为 IPictureDisp
    暗淡文件夹作为 Outlook.folder

    设置文件夹 = GetFolder(FolderPath)
    设置 myPic = LoadPicture("C:\icons\" + FolderColour + ".ico")
    如果不是（文件夹什么都没有）那么
        ' 为文件夹设置自定义图标
        文件夹.SetCustomIcon myPic
        'Debug.Print'将颜色设置为“+FolderPath+”为“+FolderColour”
    结束如果结束子

Sub ColorizeFolderAndSubFolders(strFolderPath 作为字符串，strFolderColour 作为字符串)
    ' 此过程对 strFolderPath 给出的文件夹和所有子文件夹进行着色

    Dim olProjectRootFolder 作为 Outlook.folder
    设置 olProjectRootFolder = GetFolder(strFolderPath)

    暗淡我只要
    Dim olNewFolder 作为 Outlook.MAPIFolder
    Dim olTempFolder 作为 Outlook.MAPIFolder
    Dim strTempFolderPath 作为字符串

    ' 给文件夹着色
    调用 ColorizeOneFolder(strFolderPath, strFolderColour)

     ' 循环浏览当前文件夹中的项目。
    对于 i = olProjectRootFolder.Folders.Count 为 1 步骤 -1

        设置 olTempFolder = olProjectRootFolder.Folders(i)

        strTempFolderPath = olTempFolder.FolderPath

         '在 VB 编辑器的立即窗口中打印文件夹路径和名称
         '调试.打印 sTempFolderPath

         ' 给文件夹着色
         调用 ColorizeOneFolder(strTempFolderPath, strFolderColour)
    下一个

    对于 olProjectRootFolder.Folders 中的每个 olNewFolder
        ' 递归调用
        '调试.打印olNewFolder.FolderPath
        调用 ColorizeFolderAndSubFolders(olNewFolder.FolderPath, strFolderColour)
    下一个

结束子

子 ColorizeOutlookFolders()

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

    调用 ColorizeFolderAndSubFolders("\\Mailbox - Dan Wilson\Inbox\Customers", "grey")


结束子

在对象 ThisOutlookSession 中，定义以下函数：

私有子Application_Startup()

为 Outlook 文件夹着色

结束子

：

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

    调用 ColorizeOneFolder("\\Personal\Documents\000-Mgmt-CH\100-People", "blue")
    调用 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", "洋红色")
    Call ColorizeOneFolder("\\个人\文档\000-Mgmt-CH\600-部门", "灰色")

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

结束子
当您在文件夹之间移动子文件夹时，它们应该保留其原来的位置
仅显示颜色，直到您下次重新启动 Outlook。

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}

Unzip the file icons.zip to C:\icons
Define the code below as Visual Basic Macros

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

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.

回复收藏 0 原文