Extraire les informations d'un mail de type rendez-vous

Bonjour à tous

J'arrive à me débrouiller en VBA Excel mais là je bloque.

Je dois réaliser un suivi des invitations dans Outlook et j'essaye désespérément de récupérer les mails que me renvois les participants.

Le problème, c’est que j’arrive à récupérer les données tels que le sujet, le destinataire … lorsque c’est un mail normal mais dès que je tombe sur un mail de type invitation j’ai un blocage.

Je souhaiterais faire un test sur ma boite mail et lorsque c’est un mail de type invitation que l’on m’a renvoyé c’est-à–dire une acceptation ou un refus, je voudrais pouvoir récupérer les données suivantes :
- Expéditeur (.SenderEmailAdress)
- Le type de mail (class)
- L’emplacement
- La date de début et de fin du rendez-vous
- Le texte (body)
- Le status (accepté, refus, provisoire)

Bonjour Samvba,

En P.J. une proposition contenant le code suivant :

Private Sub scanReception()
    Dim oSheet As Worksheet
    Dim oMail As Object
    Dim oNS As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder
    Dim oUnreadMails As Outlook.Items

    Dim sFilter As String
    Dim lRow As Long
    Dim sSubject As String, sBody As String
    Dim sLocation As String
    Dim lPos1 As Long, lPos2 As Long

    Set oNS = GetNamespace("MAPI")
    Set olFolder = oNS.GetDefaultFolder(olFolderInbox)

    'Filtre sur les mails non lus
    sFilter = "@SQL=" & Chr(34) & "urn:schemas:httpmail:read" & Chr(34) & "=0"
    Set oUnreadMails = olFolder.Items.Restrict(sFilter)

    Set oSheet = ThisWorkbook.Worksheets(1)
    'On recherche la dernière ligne remplie de la feuille
    lRow = oSheet.Cells(oSheet.Rows.Count, 1).End(xlUp).Row

    'On boucle sur tous les mails non lus
    For Each oMail In oUnreadMails
        Select Case oMail.Class
            'On ne sélectionne que les mails des classes "Meeting"
            Case Is = olMeetingResponseNegative, olMeetingResponsePositive, olMeetingResponseTentative
                lRow = lRow + 1
                'On remplace les sauts de lignes dans le corps du mail
                sBody = Replace(Left(oMail.Body, 300), vbCrLf, "|")
                'On récupère l'emplacement dans le corps du mail
                lPos1 = InStr(1, sBody, "?|")
                If lPos1 > 0 Then
                    lPos2 = InStr(lPos1, sBody, "(")
                    sLocation = Mid(sBody, lPos1 + 2, lPos2 - (lPos1 + 2))
                Else
                    sLocation = ""
                End If

                'On remplit les colonnes de la nouvelle ligne
                oSheet.Range("A" & CStr(lRow)).Value = oMail.GetInspector.CurrentItem.ReplyRecipients.Item(1).Name 'Expéditeur
                oSheet.Range("B" & CStr(lRow)).Value = oMail.Class
                oSheet.Range("C" & CStr(lRow)).Value = oMail.ReminderTime 'Date de début
                oSheet.Range("D" & CStr(lRow)).Value = sLocation
                oSheet.Range("E" & CStr(lRow)).Value = sBody
                'On indique le statut
                Select Case oMail.Class
                    Case Is = olMeetingResponseNegative
                        oSheet.Range("F" & CStr(lRow)).Value = "Refus"
                    Case Is = olMeetingResponsePositive
                        oSheet.Range("F" & CStr(lRow)).Value = "Accepté"
                    Case Is = olMeetingResponseTentative
                        oSheet.Range("F" & CStr(lRow)).Value = "Provisoire"
                End Select
                'On indique que le mail est lu
                oMail.UnRead = False

        End Select
    Next

    'On fait le ménage
    Set oMail = Nothing
    Set olFolder = Nothing
    Set oNS = Nothing
    Set oSheet = Nothing
End Sub