Comment définir une icône personnalisée d'un dossier Outlook?

Question

Est-il possible de définir une icône personnalisée d'un dossier ou sous-dossier Outlook à l'aide du modèle d'objet Outlook?

Answer 1

D'après ce que j'ai lu c'est malheureusement pas possible dans Outlook 2007.

Il est possible dans Outlook 2010 en utilisant MAPIFolder.SetCustomIcon. Voir MSDN pour plus de détails: http://msdn.microsoft.com/en-us/library/ff184775.aspx

Commutation de la liste des méthodes MAPIFolder entre 2010 et 2007 sur la page Web MSDN suivant montre la méthode SetCustomIcon pour 2010 seulement: http://msdn.microsoft.com/en-us/library/bb645002.aspx

Answer 2

A partir de Outlook 2010, vous pouvez utiliser MAPIFolder.SetCUstomIcon comme décrit ci-dessus .

J'ai eu le même problème récemment et trouvé un bon bout de code VBA à Change Outlook folders colors possible?:

joelandre_{Jan 12, 2015 at 9:13 PM}

1. Décompressez le fichier icons.zip à C: \ icons
2. Définissez le code ci-dessous en tant que Visual Basic Mac ros

3. adapter la fonction ColorizeOutlookFolders selon vos besoins Texte

   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. Dans le ThisOutlookSession objet, définir la fonction suivante:

   Private Sub Application_Startup() 
   
   ColorizeOutlookFolders 
   
   End Sub 
   

et

Pour ne pas colorer les sous-dossiers, vous pouvez utiliser la fonction ColorizeOneFolder au lieu de ColorizeFolderAndSubFolders, par ex.

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 

Lorsque vous déplacez des sous-dossiers entre les dossiers, ils doivent conserver leur couleur jusqu'à la prochaine fois que vous redémarrez Outlook.