2010-01-10 49 views
4

有什麼方法可以使用Outlook對象模型設置Outlook文件夾或子文件夾的自定義圖標嗎?如何設置Outlook文件夾的自定義圖標?

+0

您定位的是哪個版本的Outlook,並且您是否有要使用的語言? – 2010-01-10 07:57:23

+0

我使用Outlook 2007和C# – m23 2010-01-10 14:30:55

回答

2

由於從Outlook 2010,您可以使用MAPIFolder.SetCUstomIcon如上所述。

最近我有同樣的挑戰和發現的VBA代碼一個很好的片段在 Change Outlook folders colors possible?

joelandreJan 12, 2015 at 9:13 PM

  1. 將文件解壓縮icons.zip到C:\圖標
  2. 將以下代碼定義爲Visual Basic Mac ROS
  3. 根據您的需要文本

    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適應功能ColorizeOutlookFolders,定義了以下功能:

    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,直到下一次。

+0

由於鏈接腐爛可能佔上風,我在腳本中進行了編輯。 – 2016-01-22 15:28:25

相關問題