Bonjour à tous,

J'ai mis au point une appli à partir d'excel qui récupère tous les messages arrivant dans la boîte de réception d'une messagerie Outlook 2003 et les sauvegarde sur un serveur au format ".msg".

Jusque là tout va bien.

Dans un deuxième temps, des collaborateurs par le biais de Userform peuvent accéder à la liste de ces messages et les consulters. Mon problème arrive à ce moment là.

Je gère l'ouverture des messages par une simple instruction ThisWorkbook.FollowHyperlink strChemin ou strChemin qui gère tout à fait bien l'ouverture. Mais ensuite, je veux pouvoir ajouter dans l'objet du mail ainsi ouvert une référence interne pour pouvoir identifier la demande tout au long des échanges mails.

Et là, je cale lamentablement. Dans le code suivant, alors qu'Outlook est bien ouvert, que le message est bien ouvert, il ne trouve rien dans ActiveInspector et plante sur myolApp.ActiveInspector.CurrentItem.Subject
.
Le pire, c'est que lorsque je vais en débugage et que je poursuis l'exécution en pas à pas à partir de l'instruction qui plante, là ça se met à fonctionner, il récupère l'objet du message et y ajoute la référence ad hoc. Je n'y comprends plus rien !!!

J'ai longuement cherché mais comme je ne maîtrise pas vraiment les objets Outlook, j'aurais besoin d'une aide précieuse et rapide sur ce sujet.

D'avance merci à tous ceux qui pourront me donner un coup de main
Schub78


Code : Sélectionner tout - Visualiser dans une fenêtre à part
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
Private Sub lstPJ_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
   Dim strChemin As String
   Dim oMessage As MailItem
   Dim myolApp As Outlook.Application
   Dim myInspectors As Outlook.Inspectors
   Dim NS As Object, Dossier As Object
   Dim Test, iCount As Integer
 
   Application.ScreenUpdating = True
 
   If lstPJ.ListIndex > -1 Then
      strChemin = ThisWorkbook.Path & "\Mails\" & lstPJ.List(lstPJ.ListIndex, 3)
      ThisWorkbook.FollowHyperlink strChemin
 
      Set myolApp = New Outlook.Application
      strSujet = myolApp.ActiveInspector.CurrentItem.Subject
 
      If txtTicket.Value <> "" Then
 
 
         intPosDeb = InStr(1, strSujet, "<RT", 0)
         If intPosDeb = 0 Then
            myolApp.ActiveInspector.CurrentItem.Subject = strSujet & " - <RT" & txtTicket.Value & ">"
            'oMessage.SaveAs strChemin, OlSaveAsType.olMSG
            'oMessage.Save
         End If
      End If
   End If
   lstPJ.ListIndex = -1
 
End Sub