VBA - Récupérer Emploi du temps Outlook

Bonjour,

Pour un projet interne, j'aimerai récupérer l'emploi du temps de l'utilisateur de l'outil,
je me retrouve bloqué selon la version d'Outlook (Microsoft 365) utilisées par les utilisateurs. (S'ils ont activés la nouvelle version d'Outlook ou non)
Egalement, dans les References VBA j'ai que "Microsoft Outlook 16.0 Object Library"

Si vous savez comment prendre en compte la version d'Outlook de l'utilisateur, je suis preneur 😊

merci

J'ai déjà fait ça, qui fonctionne très bien avec la version classique d'Outlook ( donc la case décochée)

Sub testCallOutlook()

    Dim OutlApp As New Outlook.Application
    Dim OutlCalend As Outlook.Folder
    Dim OutlItems As Outlook.Items
    Dim OutlAppointement As Outlook.AppointmentItem

    Dim sStart$, sEnd$
    Dim i%

    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    ActiveSheet.DisplayPageBreaks = False

    Set OutlApp = New Outlook.Application

    sStart = DateSerial(Year(Now), Month(Now), Day(Now))
    sEnd = DateAdd("d", 1, sStart)

    Set OutlCalend = OutlApp.GetNamespace("MAPI").GetDefaultFolder(olFolderCalendar)
    Set OutlItems = OutlCalend.Items

    OutlItems.Sort "[Start]"
    OutlItems.IncludeRecurrences = True
    Set OutlItems = OutlItems.Restrict("[Start] >= '" & Format(sStart, "ddddd h:nn AMPM") & "' AND [End] <= '" & Format(sEnd, "ddddd h:nn AMPM") & "'")

    i = 3
    For Each OutlAppointement In OutlItems
        Cells(i, 1).Value = OutlAppointement.Subject
        Cells(i, 2).Value = OutlAppointement.Start
        Cells(i, 3).Value = OutlAppointement.End
        i = i + 1
    Next OutlAppointement

End Sub

Bonjour,

je me permet de réouvrir le sujet

Bonjour,

Il vous faut :

- "Déréférencer" OutLook

- Transformer le type de vos variables OutLook en Object dans vos déclarations

- Créer une instance OutLook avec cette ligne :

 Set OutlApp = CreateObject("Outlook.Application")

- Instancier vos autres variables OutLook selon leur type à partir de OutlApp

- Supprimer vos variables à la fin du code avec Set XXX = Nothing

Merci pour ton retour,

mais je ne suis pas sur tout saisir de comment instancier les autres variables avec OutlApp,

Possible de me fournir un exemple ?

A tester :

Sub Test()

Dim OutlApp As Object
Dim OutlCalend As Object 'Outlook.folder
Dim OutlItems As Object 'Outlook.items
Dim OutlAppointement As Object 'Outlook.AppointmentItem
Dim sStart$, sEnd$
Dim i%

    Set OutlApp = CreateObject("Outlook.Application")

    With Application
         .ScreenUpdating = False: .EnableEvents = False: .DisplayAlerts = False: .Calculation = xlCalculationManual
    End With
    ActiveSheet.DisplayPageBreaks = False

    sStart = DateSerial(Year(Now), Month(Now), Day(Now))
    sEnd = DateAdd("d", 1, sStart)

    Set OutlCalend = OutlApp.GetNamespace("MAPI").GetDefaultFolder(9) ' Mettre la valeur numérique au lieu du paramètre OutLook
    Set OutlItems = OutlCalend.Items
    Debug.Print OutlItems.Count

    OutlItems.Sort "[Start]"
    OutlItems.IncludeRecurrences = True
    Set OutlItems = OutlItems.Restrict("[Start] >= '" & Format(sStart, "ddddd h:nn AMPM") & "' AND [End] <= '" & Format(sEnd, "ddddd h:nn AMPM") & "'")

    i = 3
    For Each OutlAppointement In OutlItems
        Cells(i, 1).Value = OutlAppointement.Subject
        Cells(i, 2).Value = OutlAppointement.Start
        Cells(i, 3).Value = OutlAppointement.End
        i = i + 1
    Next OutlAppointement

    Set OutlApp = Nothing: Set OutlCalend = Nothing: Set OutlItems = Nothing: Set OutlAppointement = Nothing

    With Application
         .ScreenUpdating = True: .EnableEvents = True: .DisplayAlerts = True: .Calculation = xlCalculationAutomatic
    End With

End Sub

Super merci beaucoup