6

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

4

2 回答 2

3

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

我最近遇到了同样的挑战,并在 Change Outlook 文件夹颜色可能找到了一段很好的 VBA 代码片段?

2015 年 1 月 12 日晚上9:13

  1. 将文件icons.zip解压缩到 C:\icons
  2. 将下面的代码定义为 Visual Basic 宏
  3. 根据您的需要调整功能 ColorizeOutlookFolders 文本

    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. 在对象 ThisOutlookSession 中,定义以下函数:

    Private Sub Application_Startup()
    
    ColorizeOutlookFolders
    
    End Sub
    

为了不对子文件夹着色,您可以使用函数 ColorizeOneFolder 而不是 ColorizeFolderAndSubFolders 例如

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

在文件夹之间移动子文件夹时,它们应仅保留其颜色,直到您下次重新启动 Outlook。

于 2015-08-12T14:48:03.427 回答
2

根据我的阅读,不幸的是,这在 Outlook 2007 中是不可能的。

在 Outlook 2010 中可以使用MAPIFolder.SetCustomIcon. 有关详细信息,请参阅 MSDN:http: //msdn.microsoft.com/en-us/library/ff184775.aspx

在以下 MSDN 网页上切换 2010 和 2007 之间的 MAPIFolder 方法列表SetCustomIcon仅显示 2010 的方法:http: //msdn.microsoft.com/en-us/library/bb645002.aspx

于 2011-03-01T11:42:53.810 回答