Bonjour à tous, le Forum,
J'aurai à nouveau besoin de votre aide. J'ai fouillé sur les différents forums et sur le MSDN.microsoft, mais malheureusement mes compétences sont plus que limitées dans le domaine..
Depuis Excel, je fais l'extraction des mails de dossiers de mon arborescence Outlook dans un onglet de mon classeur. Dans les champs exportés se trouve notamment le champ EntryId, qui me permet d'obtenir un identifiant unique par mail.
Mon problème est que lorsque je déplace un mail vers un autre dossier, le champ EntryId change (normal si j'en crois MSDN.microsoft), sauf que je ne sais pas comment récupérer cet EntryId pour écraser la valeur correspondante dans mon onglet Excel, et ainsi pouvoir le traiter à nouveau depuis ma procédure sous Excel.
Je précise que le code ci-après est la procédure qui me permet depuis Excel de traiter un mail (création dossier Outlook si inexistant, modification du mail, déplacement du mail, extraction pièces jointes, ...)
J'espère être suffisamment explicite, je vous remercie par avance de votre aide.
Bien cordialement.
J'aurai à nouveau besoin de votre aide. J'ai fouillé sur les différents forums et sur le MSDN.microsoft, mais malheureusement mes compétences sont plus que limitées dans le domaine..
Depuis Excel, je fais l'extraction des mails de dossiers de mon arborescence Outlook dans un onglet de mon classeur. Dans les champs exportés se trouve notamment le champ EntryId, qui me permet d'obtenir un identifiant unique par mail.
Mon problème est que lorsque je déplace un mail vers un autre dossier, le champ EntryId change (normal si j'en crois MSDN.microsoft), sauf que je ne sais pas comment récupérer cet EntryId pour écraser la valeur correspondante dans mon onglet Excel, et ainsi pouvoir le traiter à nouveau depuis ma procédure sous Excel.
Je précise que le code ci-après est la procédure qui me permet depuis Excel de traiter un mail (création dossier Outlook si inexistant, modification du mail, déplacement du mail, extraction pièces jointes, ...)
J'espère être suffisamment explicite, je vous remercie par avance de votre aide.
Bien cordialement.
Code:
Sub GestionMail()
Dim olApp As Object, NS As Object, Dossier As Object, DestDossier As Object
Dim OlExp As Object
Dim i As Object
Dim MailATraiter As String, CodeDossier As String
Dim DossierSujet As Outlook.Folder
Dim j As Integer
Dim PieceJointe As Object
'Définition de la cellule active
MailATraiter = Sheets("Feuil1").Cells(ActiveCell.Row, ActiveCell.Column).Address
'Recherche du CodeSujet
CodeSujet = Sheets("Feuil1").Cells(ActiveCell.Row, 3).Value
If CodeSujet = "" Then
MsgBox ("Pas de CodeSujet affecté. Fin")
Exit Sub
End If
If MsgBox("Traiter le mail: " & Sheets("Feuil1").Cells(ActiveCell.Row, 6) & " du " & Sheets("Feuil1").Cells(ActiveCell.Row, 8) & " de " & Sheets("Feuil1").Cells(ActiveCell.Row, 7), vbYesNo, "Confirmation requise") = vbYes Then
'Recherche/Création du dossier d'archivage Outlook
Set olApp = CreateObject("Outlook.Application")
Set OlExp = olApp.ActiveExplorer
Set NS = olApp.GetNamespace("MAPI")
Set Dossier = NS.Folders("moi").Folders("Boîte de réception").Folders("Sujet")
CodeDossier = CodeSujet
For Each DossierSujet In Dossier.Folders
If DossierSujet.Name = CodeDossier Then
Set Dossier = Dossier.Folders(CodeDossier)
Exit For
End If
Next
If DossierSujet Is Nothing Then
Set DossierSujet = Dossier.Folders.Add(CodeDossier)
End If
'Traitement du mail
Set DossierATraiter = NS.Folders("moi").Folders("Boîte de réception").Folders("A_Traiter")
For Each i In DossierATraiter.Items
If i.EntryID = Sheets("Feuil1").Cells(ActiveCell.Row, 5).Value Then 'Subject = Sheets("Feuil1").Cells(ActiveCell.Row, 6).Value Then
'i.Categories = Sheets("Feuil1").Cells(ActiveCell.Row, 13)
i.Importance = Sheets("Feuil1").Cells(ActiveCell.Row, 4).Value
i.ClearTaskFlag 'efface l'indicateur tâche
'i.FlagRequest = "Assurer un suivi" 'type de suivi
'i.ReminderTime = "10/01/2017 12:00 PM" 'date de rappel
'i.ReminderOverrideDefault = True
'i.ReminderSet = True
'i.TaskStartDate = "08/01/2017" 'date début échéance
'i.TaskDueDate = "09/01/2017" 'date fin échéance
'i.TaskCompletedDate = "07/01/2017" 'date fin de tâche
'Sauvegarde des pièces jointes
'Set PieceJointe = i.Attachments
'If PieceJointe.Count > 0 Then
' For j = 1 To PieceJointe.Count
' CreationRepertoire "C:\", CodeDossier
' CheminDossier = "C:\" & CodeDossier & "\"
' PieceJointe(j).SaveAsFile CheminDossier & PieceJointe(j).DisplayName
' Next
'End If
'Suppression image signature
'ChDrive "C"
'ChDir "C:\" & CodeDossier
'On Error Resume Next
'Kill "image001.jpg"
'Archivage
'i.Save 'Sauvegarde
i.Move DossierSujet
nouveauId =??? '<========= c'est là où je ne sais pas comment récupérer le nouvel EntryId
Sheets("Feuil1").Cells(ActiveCell.Row, 5).Value = nouveauId
End If
Next i
End If
MsgBox ("Mail " & Sheets("Feuil1").Cells(ActiveCell.Row, 6) & " du " & Sheets("Feuil1").Cells(ActiveCell.Row, 8) & " de " & Sheets("Feuil1").Cells(ActiveCell.Row, 7) & "traité")
Set olApp = Nothing
Set OlExp = Nothing
Set NS = Nothing
Set Dossier = Nothing
Set DossierATraiter = Nothing
Set PieceJointe = Nothing
End Sub