Outlook Classer les emails d'une même conversation

'---------------------------------------------------------------------------------------
' Procédure   : GetConversationsFolders
' Auteur      : Mickaël
' Date        : 23/06/2021
' Sujet       : Cette procédure est utilisée pour, à partir d'un dossier Outlook, extraire toutes
'               les 'ConversationID' des mails avec les dossier dans lesquels ces conversation ont
'               été trouvées.
'               Pour la recherche d'éléments, cette procédure utilise la fonction GetFoldersPerConversationID.
' Retourne    : Scripting.Dictionary
'                   - clef   : ConversationID
'                   - valeur : VBA.Collection de 1 ou plusieurs Outlook.Folder
' Pàaramètres :
'       - p_o_folder (Outlook.Folder) : dossier de stockage des mails
'---------------------------------------------------------------------------------------
'
Public Function GetConversationsFolders(p_o_folder As Outlook.Folder) As Object    'Scripting.Dictionary
Dim l_o_dicoRes As Object               'Scripting.Dictionary
Dim l_o_dicoConversations As Object     'Scripting.Dictionary
Dim l_o_dicoFolders As Object           'Scripting.Dictionary
Dim l_av_convKeys() As Variant
Dim l_av_convDicos() As Variant
Dim l_o_collConv As VBA.Collection
Dim l_l_iConv As Long
Dim l_av_folders() As Variant
Dim l_l_iFold As Long
    Set l_o_dicoRes = CreateObject("Scripting.Dictionary")
    Set l_o_dicoConversations = GetFoldersPerConversationID(p_o_folder)
    l_av_convKeys = l_o_dicoConversations.Keys()
    l_av_convDicos = l_o_dicoConversations.Items()
    For l_l_iConv = 0 To l_o_dicoConversations.Count - 1
        Set l_o_collConv = New VBA.Collection
        Set l_o_dicoFolders = l_av_convDicos(l_l_iConv)
        l_av_folders = l_o_dicoFolders.Items()
        For l_l_iFold = 0 To l_o_dicoFolders.Count - 1
            l_o_collConv.Add l_av_folders(l_l_iFold)
        Next l_l_iFold
        l_o_dicoRes.Add l_av_convKeys(l_l_iConv), l_o_collConv
    Next l_l_iConv
    Set GetConversationsFolders = l_o_dicoRes
    Set l_o_dicoRes = Nothing
    Set l_o_dicoConversations = Nothing
    Set l_o_dicoFolders = Nothing
    Set l_o_collConv = Nothing
End Function

'Private Function GetFoldersPerConversationID(p_o_folder As Outlook.Folder, Optional p_o_dicoRes As Scripting.Dictionary = Nothing) As Scripting.Dictionary
Private Function GetFoldersPerConversationID(p_o_folder As Outlook.Folder, Optional p_o_dicoRes As Object = Nothing) As Object
Dim l_o_subFolder As Outlook.Folder
Dim l_o_item As Object
Dim l_o_mailItem As Outlook.MailItem
Dim l_o_dicoFolders As Object       'Scripting.Dictionary
    If p_o_dicoRes Is Nothing Then Set p_o_dicoRes = CreateObject("Scripting.Dictionary")
    For Each l_o_item In p_o_folder.Items
        If TypeOf l_o_item Is MailItem Then
            Set l_o_mailItem = l_o_item
            If Not p_o_dicoRes.Exists(l_o_mailItem.ConversationID) Then p_o_dicoRes.Add l_o_mailItem.ConversationID, CreateObject("Scripting.Dictionary")
            Set l_o_dicoFolders = p_o_dicoRes.Item(l_o_mailItem.ConversationID)
            If Not l_o_dicoFolders.Exists(p_o_folder.FolderPath) Then l_o_dicoFolders.Add p_o_folder.FolderPath, p_o_folder
        End If
    Next l_o_item
    For Each l_o_subFolder In p_o_folder.Folders
        GetFoldersPerConversationID l_o_subFolder, p_o_dicoRes
    Next l_o_subFolder
    Set GetFoldersPerConversationID = p_o_dicoRes
    Set l_o_subFolder = Nothing
    Set l_o_item = Nothing
    Set l_o_mailItem = Nothing
    Set l_o_dicoFolders = Nothing
End Function

Public Sub TestStoreEmails()
Dim l_o_folderStockage As Outlook.Folder
Dim l_o_dicoConversations As Object  'Scripting.Dictionary
Dim l_o_collFolders As VBA.Collection
Dim l_o_folderConversation As Outlook.Folder
Dim l_o_selection As Outlook.Selection
Dim l_o_mailItem As Outlook.MailItem
Dim l_l_i As Long
Dim l_s_msg As String
    
    'récupérer le dossier de stockage des mails
    Set l_o_folderStockage = Application.Session.Folders("bla bla").Folders("bla bla bla")
    'en extraire tous les dossier par conversation
    Set l_o_dicoConversations = GetConversationsFolders(l_o_folderStockage)
    
    'boucler sur chaque élément sélectionné
    Set l_o_selection = Application.ActiveExplorer.Selection
    For l_l_i = 1 To l_o_selection.Count
        'filtrer sur les éléments de type mail
        If TypeOf l_o_selection.Item(l_l_i) Is MailItem Then
            Set l_o_mailItem = l_o_selection.Item(l_l_i)
            's'il existe déjà un email classé pour la même conversation
            If l_o_dicoConversations.Exists(l_o_mailItem.ConversationID) Then
                'afficher les détails
                Set l_o_collFolders = l_o_dicoConversations.Item(l_o_mailItem.ConversationID)
                l_s_msg = l_o_collFolders.Count & " dossier(s) de stockage trouvé(s) pour le mail '" & l_o_mailItem.Subject & "' :"
                For Each l_o_folderConversation In l_o_collFolders
                    l_s_msg = l_s_msg & vbNewLine & "   - " & l_o_folderConversation.FolderPath
                Next l_o_folderConversation
                MsgBox l_s_msg, vbOKOnly + vbInformation, "Info"
            'sinon
            Else
                MsgBox "Aucun dossier de stockage trouvé pour le mail '" & l_o_mailItem.Subject & "'.", vbOKOnly + vbExclamation, "Info"
            End If
        End If
    Next l_l_i
    
    Set l_o_folderStockage = Nothing
    Set l_o_dicoConversations = Nothing
    Set l_o_collFolders = Nothing
    Set l_o_folderConversation = Nothing
    Set l_o_selection = Nothing
    Set l_o_mailItem = Nothing
End Sub