Extraire réunion outlook avec VBA Excel

Le 25/05/2023 à 16:26

Bonjour, j'essaye d'extraire les données de rendez-vous gérées par le calendrier outlook pour les implétementer sur excel afin de pouvoir réaliser des statistiques dessus par la suite.

Débutante j'ai d'abord cherché des solution sur internet et j'ai trouvé un code qui marche à peu près qui est le suivant.

Sub RetrieveApts()

    Dim olApp As Object
    Dim olNS As Object
    Dim olFolder As Object
    Dim olApt As Object
    Dim oAppointments As Object

    Dim folderItems As Outlook.Items

    Dim NextRow As Long

    Dim FromDate As Date
    Dim ToDate As Date

    Dim pos As Integer

    ' Cannot increase performance of broken code
    '  This hides clues, if there are any
    ' Uncomment when code is satisfactory.
    'Application.ScreenUpdating = False ' Turns off performance reducing functionality
    'Application.CutCopyMode = False ' Turns off performance reducing functionality

    FromDate = CDate("10/04/2023")
    ToDate = CDate("28/05/2023")

    ' This is a rare valid use of
    On Error Resume Next
    '  if turned off when the purpose is served.
    ' Bypass expected error if Outlook is not open

    Set olApp = GetObject(, "Outlook.Application") 'Sets Outlook Reference
    If Err.Number > 0 Then Set olApp = CreateObject("Outlook.Application") 'Opens Outlook if Outlook was Closed

    ' Return to normal error handling to see unexpected errors
    On Error GoTo 0

    Set olNS = olApp.GetNamespace("MAPI")
    Set olFolder = olNS.GetDefaultFolder(9)

    NextRow = 2

    Set folderItems = olFolder.Items

    With folderItems

        .Sort "[Start]"
        .IncludeRecurrences = True
    End With

    With Sheets("feuil2")

        .Range("A1:H1").Value = Array("Objet", "Date", "Durée", "Emplacement", "Required Attendees", "Optional Attendees", "Categorization", "Body")

        Set olApt = folderItems.Find("[Start] >= """ & FromDate & """ and [Start] <= """ & ToDate & """")

        While TypeName(olApt) <> "Nothing"

            .Cells(NextRow, "A").Value = olApt.Subject
            .Cells(NextRow, "B").Value = CDate(olApt.Start)
            .Cells(NextRow, "B").NumberFormat = "ddd yyyy/mm/dd hh:mm"

            .Cells(NextRow, "C").Value = olApt.End - olApt.Start
            .Cells(NextRow, "C").NumberFormat = "HH:MM:SS"

            .Cells(NextRow, "D").Value = olApt.Location
            .Cells(NextRow, "E").Value = olApt.RequiredAttendees

            .Cells(NextRow, "F").Value = olApt.OptionalAttendees
            .Cells(NextRow, "G").Value = olApt.Categories

            .Cells(NextRow, "H").Value = olApt.Body

            NextRow = NextRow + 1

            Set olApt = folderItems.FindNext
        Wend

    End With

    ActiveSheet.Columns.AutoFit

    Set olApt = Nothing
    Set olFolder = Nothing
    Set olNS = Nothing
    Set olApp = Nothing

    Application.ScreenUpdating = True
    Application.CutCopyMode = True

    Debug.Print "Done."

End Sub

Cependant, une fois le programme exécuté les lignes suivantes ne fonctionnent pas et je suis obligée de les enlever pour avoir mon tableau :

.Cells(NextRow, "E").Value = olApt.RequiredAttendees

            .Cells(NextRow, "F").Value = olApt.OptionalAttendees
            .Cells(NextRow, "G").Value = olApt.Categories

            .Cells(NextRow, "H").Value = olApt.Body

J'ai l'erreur "La méthode 'RequiredAttendees' de l'objet '_AppointmentItemt'a échoué.

Comment puis-je y remédier pour avoir les informations ?

Merci d'avance pour l'aide.

Le 26/05/2023 à 10:25

Bonjour,

Vous pouvez déjà conditionner le remplissage de

.Cells(NextRow, "E").Value = olApt.RequiredAttendees

par cette instruction :

            If olApt.MeetingStatus <> 0 Then
                .Cells(NextRow, "E").Value = olApt.RequiredAttendees
                .Cells(NextRow, "F").Value = olApt.OptionalAttendees
            End If

ensuite, si vous voulez tous les événements dans votre fourchette de dates, vous devez modifier cette instruction

Set olApt = folderItems.Find("[Start] > """ & FromDate & """ and [Start] < """ & ToDate + 1 & """")

L'égalité ne fonctionne pas avec ce filtre.

Le 26/05/2023 à 11:04

Bonjour,

J'ai déjà essayer de contourner l'erreur avec un If notamment en essayant de faire :

If Len(olApt.RequiredAttendees) > 0 Then 
    .Cells(NextRow, "E").value = olAptRequiredAttendees
End If

ou aussi en faisant :

If olApt.RequiredAttendees <> "" Then 
    .Cells(NextRow, "E").Value = olApt.RequiredAttendees
End If

J'ai essayé de remplacer par le code que vous m'avez proposé mais l'erreur persiste à l'intérieur de la condition If olApt.MeetingStatus <> O Then

Je ne suis pas sûre de comprendre pourquoi l'égalité ne fonctionne pas avec ce filtre. Je pensais que la méthode Find allée pouvoir chercher la première occurrence du rendez-vous correspondant à la date de départ et de fin que j'ai entrée. Et je l'assigne à la variable olApt pour l'utilisée dans la boucle while ensuite.

Pourriez-vous m'aider davantage.

Merci beaucoup.

Le 26/05/2023 à 11:55

Avec ce code plus de problème

            If olApt.MeetingStatus <> 0 Then
                On Error Resume Next
                .Cells(NextRow, "E").Value = olApt.RequiredAttendees
                .Cells(NextRow, "F").Value = olApt.OptionalAttendees
                On Error GoTo 0
            End If

Je ne suis pas sûre de comprendre pourquoi l'égalité ne fonctionne pas avec ce filtre

Pour que l'égalité fonctionne, il faudrait sans doute que les dates soient définies dans un format bien précis. En tout la modification que je vous ai soumise, résout le problème.

Le 26/05/2023 à 12:12

En effet, l'erreur n'apparaît plus mais le programme ne remplit pas ses fonctionnalités.

J'ai crée une réunion à la date d'hier avec des destinataires et une description et les colonnes de mon tableau sont vide pour ses caractéristiques. Je pense que ça a généré une erreur et n'a pas su récupérer l'information mais le On Error to Go et resume next permettent au code de continuer malgré l'erreur si j'ai bien compris.

Avez -vous une idée de pourquoi ça ne fonctionne pas ?

Merci !

Le 26/05/2023 à 18:43

Avez -vous une idée de pourquoi ça ne fonctionne pas ?

Question de base : retrouvez-vous bien le sujet et la date de la réunion que vous avez créée ?

Une fois la réunion créée, on retrouve dans olApt.RequiredAttendees, les destinataires obligatoires et dans olApt.OptionalAttendees, les destinataires facultatifs.

Le 26/05/2023 à 19:22

J'arrive à retrouver dans mon tableau l'objet, la date, la durée et l'emplacement des rendez-vous crées mais ça ne marche pas pour les destinataires obligatoires (required attendees) et facultatifs (optional attendees) et aussi la description (body) qui restent des cases vides malgré la présence de destinaires et d'une description dans les réunions.

Le 27/05/2023 à 00:47

En y réfléchissant, je pense que votre version d'Office ne doit pas être de 2016 comme vous l'indiquez, mais certainement antérieure. Ce qui expliquerait le non fonctionnement de certaines propriétés, disponibles seulement dans les dernières versions.

Ce code devrait fonctionner avec votre version :

            Dim destinataires1 As String, destinataires2 As String

            If olApt.MeetingStatus <> 0 Then
                destinataires1 = Empty: destinataires2 = Empty
                For Each destinataire In olApt.Recipients
                    Select Case destinataire.Type
                        Case 1 'destinataire obligatoire
                            destinataires1 = destinataires1 & destinataire.Name & ";"
                        Case 2 'destinataire facultatif
                            destinataires2 = destinataires2 & destinataire.Name & ";"
                    End Select
                Next destinataire
                .Cells(NextRow, "E").Value = destinataires1
                .Cells(NextRow, "F").Value = destinataires2
            End If
Le 30/05/2023 à 09:30

Bonjour, désolé de ma réponse tardive. J'ai implémenté votre programme mais j'ai une erreur 287 : "Erreur définie par l'application ou par l'objet" sur la ligne :

For Each destinataire In olApt.Recipients
Le 30/05/2023 à 11:46

J'ai implémenté votre programme mais j'ai une erreur 287 : "Erreur définie par l'application ou par l'objet" sur la ligne :

Ajouter dans les définitions de variable :

Dim destinataire As Object
Le 30/05/2023 à 14:10

J'ai essayé de définir la variable destinataire comme objet ça ne marchait pas j'ai ensuite essayé comme variant toujours la même erreur.

Le 30/05/2023 à 15:52

Il semblerait donc que même la propriété "Recipients" de la classe "AppointmentItem" ne soit pas disponible dans votre version d'Office.

Est-ce vraiment Office 2016 ? Si oui, à mon avis, vous avez un problème d'installation. Est-elle bien activée ?

Le 30/05/2023 à 16:20

J'ai bien vérifié j'ai bien le pack office standard 2016 en regardant les informations de mon compte et ça me semble bien installé mais je ne sais pas comment vérifier à vrai dire...

Le 30/05/2023 à 19:48

je ne sais pas comment vérifier à vrai dire...

Outlook --> onglet fichier --> compte Office

Le 31/05/2023 à 09:19

Pardon je me suis mal exprimée j'ai déjà vérifié surement que je possédais le pack office standard 2016 en regardant mon compte dans les informations. Je n'étais pas sûre d'entendre ce que vous sous entendiez par mal installée ou non activée.

Le 31/05/2023 à 17:10

Si vous regardez votre compte dans les informations, vous saurez immédiatement si votre office 2016 est activé.

office 2016 active

Vous ne seriez pas par hasard sous Mac ?

Rechercher des sujets similaires à "extraire reunion outlook vba"