Recherche info dans outllok

Bonjour,

J'ai ce code qui me permet de me rendre à une date donnée dans le calendrier outlook

Sub VerifDansCalendrierOutlook()
 Dim appOutlook As Outlook.Application
    Dim outEspace As Outlook.Namespace
    Dim outCalendarView As Outlook.CalendarView
    Dim outDossier As Outlook.Folder
    Dim datGoTo As Date

    Set appOutlook = Outlook.Application    ' Si Outlook est ouvert, permet d'utiliser les membres de l'application
    Set outEspace = appOutlook.Session  ' Equivaut à appOutlook.GetNamespace("MAPI"), charge les membres de la session Outlook en cours

    datGoTo = "10/05/2021"  ' Date à atteindre

    Set outDossier = outEspace.GetDefaultFolder(olFolderCalendar)   ' Charge le dossier Calendrier par défaut de la session en cours

    Set appOutlook.ActiveExplorer.CurrentFolder = outDossier ' Affiche le calendrier chargé
    Set outCalendarView = appOutlook.ActiveExplorer.CurrentView ' Charge la vue courante du calendrier affiché

    ' Manipulation de la vue courante :
    With outCalendarView
        .GoToDate datGoTo  ' Atteint la date choisie
        .CalendarViewMode = olCalendarViewMonth ' Qualifie l'affichage du calendrier affiché (ici semaine de travail)
        .save   ' Applque le changement de vue. Sans cette ligne, CalendarViewMode ne s'applique pas
    End With
End Sub

Je voudrais vérifier si à cette date (en journée entière) existe un événement comprenant le mot "fh" et le mot "nuit"

Si aucun événement existe avec ces critères, alors je voudrais créer un événement en journée entière

Peut-être qu'il n'y a pas besoin d'afficher outlook pour faire cela et donc épurer ce code ?

Pourriez vous m'aider svp?

Je vous remercie beaucoup

Cordialement

Hello,

Jamais fait, mais peut être un début de piste avec la propriété "Filter" de CalendarView

Sub VerifDansCalendrierOutlook()
 Dim appOutlook As Outlook.Application
    Dim outEspace As Outlook.Namespace
    Dim outCalendarView As Outlook.CalendarView
    Dim outDossier As Outlook.Folder
    Dim datGoTo As Date

    Set appOutlook = Outlook.Application    ' Si Outlook est ouvert, permet d'utiliser les membres de l'application
    Set outEspace = appOutlook.Session  ' Equivaut à appOutlook.GetNamespace("MAPI"), charge les membres de la session Outlook en cours

    datGoTo = "10/05/2021"  ' Date à atteindre

    Set outDossier = outEspace.GetDefaultFolder(olFolderCalendar)   ' Charge le dossier Calendrier par défaut de la session en cours

    Set appOutlook.ActiveExplorer.CurrentFolder = outDossier ' Affiche le calendrier chargé
    Set outCalendarView = appOutlook.ActiveExplorer.CurrentView ' Charge la vue courante du calendrier affiché

    ' Manipulation de la vue courante :
    With outCalendarView
        .GoToDate datGoTo  ' Atteint la date choisie
        .CalendarViewMode = olCalendarViewMonth ' Qualifie l'affichage du calendrier affiché (ici semaine de travail)
.Filter = "*fh*"
        .save   ' Applque le changement de vue. Sans cette ligne, CalendarViewMode ne s'applique pas
    End With
End Sub

Bonsoir,

ci-dessous exemple de code :

Sub VerifDansCalendrierOutlook()

    Dim olApp As Outlook.Application
    Dim calendrier As Outlook.Folder
    Dim evts_trouvés As Outlook.Items
    Dim evt As Outlook.AppointmentItem
    Dim filtre As String
    Dim date_rech As Date
    Dim evt_ok As Boolean

    'définition application
    Set olApp = Outlook.Application

    'affectation calendrier
    Set calendrier = olApp.Session.GetDefaultFolder(olFolderCalendar)

    'recherche des événements correspondant à une date
    date_rech = CDate("10/05/2021")
    filtre = "[Start] > '" & Format(date_rech - 1, "ddddd") & "'" & "And" & "[Start] < '" & Format(date_rech + 1, "ddddd") & "'"
    Set evts_trouvés = calendrier.Items.Restrict(filtre)

    'analyse des événements trouvés
    evt_ok = False
    For Each evt In evts_trouvés
        If evt.AllDayEvent Then
            If evt.Subject Like "*fh*" And evt.Subject Like "*nuit*" Then evt_ok = True: MsgBox "événement existe au " & evt.Start
        End If
    Next evt
    If evt_ok Then Exit Sub

    'création éventuelle d'un événement à la date demandée
    MsgBox "création événement au " & date_rech
    Set evt = calendrier.Items.Add(olAppointmentItem)

    evt.Subject = "sujet"
    evt.AllDayEvent = True
    evt.Start = date_rech
    evt.ReminderSet = False
    evt.Location = "lieu"

    evt.Save

End Sub

C'est trop bien

J'ai inséré votre code dans une boucle, j'ai seulement modifié cette ligne et tout fonctionne à merveille

filtre = "[Start] > '" & Format(date_rech - 1, "ddddd") & "'" & "And" & "[Start] < '" & Format(date_rech, "ddddd") & "'"

j'ai changé date_rech +1 par date_rech sinon il me prenait pas toutes les dates de la boucle

Je vous remercie beaucoup

Vraiment beaucoup

Cordialement