Как установить пользовательский значок папки Outlook?

Question

Есть ли способ установить пользовательский значок папки или подпапки Outlook, используя объектную модель Outlook?

Answer 1

Начиная с Outlook 2010, вы можете использовать MAPIFolder.SetCUstomIcon, как описано выше.

Недавно у меня была такая же проблема, и я нашел хороший фрагмент кода VBA на Возможно ли изменить цвета папок Outlook? :

Джоеландр _{12 января 2015 года в 21: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.

Answer 2

Из того, что я прочитал, это, к сожалению, невозможно в Outlook 2007.

Это возможно в Outlook 2010 с использованием MAPIFolder.SetCustomIcon. См. MSDN для получения более подробной информации: http://msdn.microsoft.com/en-us/library/ff184775.aspx

Переключение списка методов MAPIFolder между 2010 и 2007 на следующей веб-странице MSDN показывает метод SetCustomIcon только для 2010: http://msdn.microsoft.com/en-us/library/bb645002.aspx