Outlook 2010：为邮件文件夹着色？

Question

有人知道如何在 Outlook 2010 中获取彩色文件夹吗？

Outlook 中没有集成此类功能...还有其他方法吗？编程语言？它是如何运作的？

谢谢。

Answer 1

不，Outlook 中的彩色文件夹还没有实现。

Answer 2

我针对此需求实现了一个 VBA 解决方案，基于：

• 设计由彩色方块（红色、蓝色、绿色等）组成的图标
• 将图标存储在定义的本地目录中
• 以编程方式 (VBA) 将图标分配给邮件文件夹。

结果： 示例

如何

• 在 C:\icons 中创建图标文件（例如 red.ico、blue.ico）或将此文件解压到 C:\icons icons

• 定义下面的VBA代码并根据您的需要调整函数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

• 要在 Outlook 启动时启动着色，请在 VBA 对象 ThisOutlookSession 中定义以下函数：

   Private Sub Application_Startup()
     ColorizeOutlookFolders
   End Sub