IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

  1. #41
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    4 081
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 4 081
    Points : 7 033
    Points
    7 033
    Billets dans le blog
    20
    Par défaut


    Il faut essayer de comprendre ce qui se passe dans ce code !

    on se connecte à outlook
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set ol = CreateObject("outlook.application")
    puis à la session
    on recherche le calendrier par defautl et on ouvre un EXPLORER (une fenetre OUTLOOK sur les calendriers)
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set ObjExpCal = ObjNS.GetDefaultFolder(olFolderCalendar).GetExplorer
    on se positionne dans la partie CALENDRIER (colonne de gauche )
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Set ObjNavMod = ObjExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
    puis dans la section "tous les calendriers de groupe"
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    Set objcalgr = ObjNavMod.NavigationGroups.Item("Tous les calendriers de groupe") 'ici on selectionne le groupe
     
    'on se positionne dans la collection de calendriers de cette section
    Set ObjNavCalPart = ObjNavMod.NavigationGroups.Item("Tous les calendriers de groupe").NavigationFolders
    ensuite il faut en sélectionner 1 par son nom par exemple

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    set monCalendrier = ObjNavCalPart("toto")
    et si on veut parcourir ce calendrier il faut retrouver le FOLDER correspondant

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    set ofolder = monCalendrier.folder
    et on parcours les éléments qui sont dans

    Comment s'appelle ton calendrier de groupe ?

  2. #42
    Nouveau membre du Club
    Homme Profil pro
    Getion appro planning
    Inscrit en
    août 2020
    Messages
    35
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 61
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Getion appro planning
    Secteur : Industrie

    Informations forums :
    Inscription : août 2020
    Messages : 35
    Points : 35
    Points
    35
    Par défaut
    Bonjour,

    super grand merci pour ce cours, c'est vrais que je tâtonne pour trouver la solution, avec ce mini cours c'est plus claire,


    j'ai testé avec cette logique, et ca marche

    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
    Sub TrouveCalendrierPartagé3()
    Dim OlFolder As Outlook.MAPIFolder
    Dim OlAppointment As Outlook.AppointmentItem
    Dim ObjNS As Outlook.Namespace
    Dim ObjExpCal As Outlook.Explorer
    Dim ObjNavMod As Outlook.CalendarModule
    Dim ObjNavCalPart As Outlook.NavigationFolders
    Dim i, objitem As Object
    Dim subject As String
    Dim PartieNom As String
    PartieNom = "tatus-Equip"
    c = "Status-Equipe"
    Set ol = CreateObject("outlook.application")
    Set ObjNS = ol.Session
    Set ObjExpCal = ObjNS.GetDefaultFolder(olFolderCalendar).GetExplorer
    Set ObjNavMod = ObjExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
    Set objcalgr = ObjNavMod.NavigationGroups.Item("Tous les calendriers de groupe") 'ici on selectionne le groupe
    Set ObjNavCalPart = ObjNavMod.NavigationGroups.Item("Tous les calendriers de groupe").NavigationFolders
    Set monCalendrier = ObjNavCalPart("Planning Technique") 'ensuite il faut en s?lectionner 1 par son nom par exemple
    Set OlFolder = monCalendrier.Folder ' et si on veut parcourir ce calendrier il faut retrouver le FOLDER correspondant
    'With Sheets("donn?es")     'mettre le nom de la feuille en remplacement de Feuil1
            'Parcourir les cellules de la colonne A de la ligne 2 ? la derni?re ligne occup?
            For ii = OlFolder.Items.Count To 1 Step -1
            Set OlAppointment = OlFolder.Items(ii)
            If OlAppointment.subject Like ("*" & PartieNom & "*") Then OlAppointment.Delete
            'If OlAppointment.subject = c Then OlAppointment.Delete
            Set OlAppointment = Nothing
            Next
    'End With
    End Sub

    encore une question, le With n'est pas necessaire ? je l'ai supprimé et ca fonctionne aussi,

    Si j'ai bien compris dans ce code je passe en revu tous les RDV, je commence par le dernier pour être sur de les passer tous en revu, si je trouve un RDV qui contient "tatus-Equip" je le supprime, (j'ai utilisé "Like" pour utilise la condition "contient ceci "tatus-Equip")

    ---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------

    après j'ai encore fouillé sur le net et j'ai trouvé ceci:

    dans ce code il y a la fonction "restrict(sFilter)" j'ai l'impression que ce code récupère tous les RDV qui correspondent aux restrictions et les supprimes dans l'ordre croissant,

    est ce que cette structure de code est plus rapide ? (car on passe en revu que les RDV qui correspondent au filtre ?)
    (j'ai 30 RDV par jour et l'horizon de mise à jour est de 90 jours ce qui fait 2700 RDV à passer en revu.)

    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
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    60
    61
    62
    63
    64
    65
    66
    67
    68
    69
    70
    71
    72
    73
    74
    75
    76
    77
    78
    79
    80
    81
    82
    83
    84
    85
    86
    87
    88
    89
    Sub TestSupprRDV()
    Call SupprDansCalendrier("Contrat", "Pour Forum Developpez", "09/05/2020", "18:00:00", 60, "OUF !!!", "Enfin, j'ai r?ussi", "Cat?gorie Vert")
    End Sub
    Sub SupprDansCalendrier(xCalendrier, xTitre, xDateDeb, xHeurDeb, xDuree, xLieu, xBody, xCat?gorie)
    '---------------------------------------------------------------------------------------
    ' Cr?ation d'un RDV sur Agenda OUTLOOK
    '---------------------------------------------------------------------------------------
    Dim OLApp As Outlook.Application
    Dim ObjNS As Outlook.Namespace
    Dim ObjExpCal As Outlook.Explorer
    Dim ObjNavMod As Outlook.CalendarModule
    Dim ObjNavCalPart As Outlook.NavigationFolders
    Dim ObjNavFolder As Outlook.NavigationFolder
    Dim CollectionAppointments As Outlook.Items
    Dim FolderPartage As Outlook.Folder
    Dim F
    Dim xTrouve As Boolean
    Set OLApp = CreateObject("outlook.application")
    Set ObjNS = OLApp.Session
    Set ObjExpCal = ObjNS.GetDefaultFolder(olFolderCalendar).GetExplorer
    Set ObjNavMod = ObjExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar)
    'Set objNavCalPart = objNavMod.NavigationGroups.Item("Mes calendriers").NavigationFolders 'Famille Mes calendriers
    'Set objNavCalPart = objNavMod.NavigationGroups.Item("Autres calendriers").NavigationFolders 'Famille Autres calendriers
    'Set objNavCalPart = objNavMod.NavigationGroups.Item("Calendriers partag?s").NavigationFolders 'Famille Calendriers partag?s
    '--------------------------------------------------------------------------------------
    ' Parcours la liste des familles de calendrier et les calendriers de chaque famille
    '--------------------------------------------------------------------------------------
    xTrouve = False
    xNbrFamCal = ObjNavMod.NavigationGroups.Count
    For F = 1 To xNbrFamCal
    xNbrSousCal = ObjNavMod.NavigationGroups.Item(F).NavigationFolders.Count
    For G = 1 To xNbrSousCal
    xNomFamilleCal = ObjNavMod.NavigationGroups.Item(F).Name
    xNomCalendrier = ObjNavMod.NavigationGroups.Item(F).NavigationFolders.Item(G).DisplayName
    If xNomCalendrier = xCalendrier Then
    On Error Resume Next
    Set ObjNavCalPart = ObjNavMod.NavigationGroups.Item(xNomFamilleCal).NavigationFolders
    Set ObjNavFolder = ObjNavCalPart(xCalendrier)
    Set MonSousDoss = ObjNavCalPart(G)
    'FoldName = MonSousDoss.Folder.Name & "-" & MonSousDoss.Folder.FullFolderPath
    If Err Then
    xTrouve = False
    MsgBox "Calendrier : " & xCalendrier & " non acc?ssible !!!", vbCritical, "ERREUR"
    Else
    xTrouve = True
    xMess = Empty
    xMess = xMess & "FAMILLE = " & xNomFamilleCal & Chr(13) & Chr(13)
    xMess = xMess & Space(10) & "CALENDRIER = " & xNomCalendrier
    MsgBox xMess, vbInformation, "FAMILLE & CALENDRIER"
    End If
    Exit For
    Else
    xTrouve = False
    End If
    Next G
    If xTrouve = True Then
    Exit For
    End If
    Next F
    If xTrouve = False Then
    MsgBox "Calendrier : " & xCalendrier & " non trouv? !!!!", vbCritical, "CALENDRIER"
    Exit Sub
    End If
    If MonSousDoss <> Empty Then
    '----------------------------------------------------------
    ' R?cup?ration des donn?es du tableau
    '----------------------------------------------------------
    xStart = xDateDeb & " " & Deux(Hour(xHeurDeb)) & ":" & Deux(Minute(xHeurDeb))
    xConcat = xTitre & "-" & xStart & ":00-" & xCat?gorie
    sFilter = "[Start] >= '" & xStart & "'" 'D?finit les crit?res de filtre
    sFilter = "[Start] = '" & xStart & "'" 'D?finit les crit?res de filtre
    Set CollectionAppointments = MonSousDoss.Folder.Items.Restrict(sFilter)
    '--------------------------------------------------------
    ' Boucle sur tous les rdv trouv?s
    '--------------------------------------------------------
    For Each oAppointment In CollectionAppointments
    xTitRDV = oAppointment.subject 'Titre
    xDebRDV = oAppointment.Start 'Date et Heure de d?but
    xFinRDV = oAppointment.End 'Date et Heure de fin
    xEmpRDV = oAppointment.Location 'Emplacement
    xBodRDV = oAppointment.Body 'Corps
    xCatRDV = oAppointment.Categories 'Cat?gorie (couleur)
    xConcatRDV = xTitRDV & "-" & xDebRDV & "-" & xCatRDV
    If xConcatRDV = xConcat Then
    'MsgBox "Suppression = " & xTitre & " " & xDeb
    oAppointment.Delete
    End If
    Next
    End If




    Cordialement

  3. #43
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    4 081
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 4 081
    Points : 7 033
    Points
    7 033
    Billets dans le blog
    20
    Par défaut
    Oui restrict permet d'accélérer le code

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    filter = "@SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0037001E" _  
        & Chr(34) & " ci_phrasematch " & PartieNom 
     
     Set OlAppointmentS = OlFolder.Items.restrict(filter)
     For ii = OlAppointmentS.Count To 1 Step -1
            Set OlAppointment = OlAppointmentS(ii)

  4. #44
    Nouveau membre du Club
    Homme Profil pro
    Getion appro planning
    Inscrit en
    août 2020
    Messages
    35
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 61
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Getion appro planning
    Secteur : Industrie

    Informations forums :
    Inscription : août 2020
    Messages : 35
    Points : 35
    Points
    35
    Par défaut
    Bonsoir,

    alors là je crois que je suis comletement perdu,
    je comprend pas cette partie:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    filter = "@SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0037001E" _  
        & Chr(34) & " ci_phrasematch " & PartieNom
    je vais fouiller encore sur le net pour comprendre,
    j'ai trouvé ceci:
    est ce que la partie en rouge est une bonne piste pour filtrer sur un intervalle de date ? et cumuler avec un ou plusieurs critères de selection ?(date + titre + category)


    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
    32
    33
    34
    35
    36
    37
    38
    39
    40
    41
    42
    43
    44
    45
    46
    47
    48
    49
    50
    51
    52
    53
    54
    55
    56
    57
    58
    59
    Dim OutlookApp As Outlook.Application
    Dim OutlookNamespace As Namespace
    Dim Folder As MAPIFolder
    Dim OutlookMail As Variant
    Dim i As Integer
    Dim olItems As Outlook.Items
    Dim myItems As Outlook.Items
    Dim DateStr As Date
    Dim DateEnd As Date
    Dim oOlResults As Object
    
    Dim DateToCheck As String
    Dim DateToCheck2 As String
    Dim DateToCheck3 As String
    
    Set OutlookApp = New Outlook.Application
    Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
    
    Dim olShareName As Outlook.Recipient
    Set olShareName = OutlookNamespace.CreateRecipient("Mailbox.sharedmailbox@example.ca")
    Set Folder = OutlookNamespace.GetSharedDefaultFolder(olShareName, olFolderInbox).Folders("sub1").Folders("sub2")
    Set olItems = Folder.Items
    
    
    'DateStr = 1/16/2018
    'DateEnd = 1/17/2018
    
    DateStr = Format(Range("From_Date").Value, "DDDDD HH:NN")
    DateEnd = Format(Range("To_Date").Value, "DDDDD HH:NN")
    
    'DateStr = DateAdd("d", -1, DateStr)
    'DateEnd = DateAdd("d", 1, DateEnd)
    
    DateToCheck = "[ReceivedTime] > """ & DateStr & """"
    DateToCheck2 = "[ReceivedTime] <= """ & DateEnd & """"
    DateToCheck3 = "[SenderName] = ""no-reply@example.com"""
    
    Set myItems = olItems.Restrict(DateToCheck)
    Set myItems = myItems.Restrict(DateToCheck2)
    Set myItems = myItems.Restrict(DateToCheck3)
    
    i = 1
    
    For Each myitem In myItems
        ' MsgBox myitem.ReceivedTime
    
         Range("eMail_subject").Offset(i, 0).Value = myitem.Subject
         Range("eMail_date").Offset(i, 0).Value = myitem.ReceivedTime
    
         i = i + 1
    
    Next myitem
    
    Set Folder = Nothing
    Set OutlookNamespace = Nothing
    Set OutlookApp = Nothing
    
    
    End Sub

    cordialement

  5. #45
    Nouveau membre du Club
    Homme Profil pro
    Getion appro planning
    Inscrit en
    août 2020
    Messages
    35
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 61
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Getion appro planning
    Secteur : Industrie

    Informations forums :
    Inscription : août 2020
    Messages : 35
    Points : 35
    Points
    35
    Par défaut
    Bonsoir,

    voila ce que j'ai testé, j'ai copié que la fin le début reste inchangé, j'ai ausi ajouté un "s" devant Filter car j'avait un un message d'erreur
    "erreur de compilation ou argument non facultatif"

    maintenant j'ai un message d'erreur sur la ligne 6 "erreur d'execution '-21473blablabla impossible d'analyser la condition"




    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
    4
    5
    6
    7
    8
    9
    10
    11
    12
    13
    14
    Set OlFolder = monCalendrier.Folder ' et si on veut parcourir ce calendrier il faut retrouver le FOLDER correspondant
     
        Filter = "@SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0037001E" _
        & Chr(34) & " ci_phrasematch " & PartieNom
     
        Set OlAppointmentS = OlFolder.Items.Restrict(Filter)
           'Parcourir les cellules de la colonne B de la ligne 2 à la dernière ligne occupé
        For ii = OlAppointmentS.Count To 1 Step -1 'compteur a l'envers
        Set OlAppointment = OlAppointmentS(ii)
            If OlAppointment.subject Like ("*" & PartieNom & "*") Then OlAppointment.Delete 'selection et suppression
            'If OlAppointment.subject = c Then OlAppointment.Delete
            Set OlAppointment = Nothing 'on vide la memoire
            Next
    End Sub
    qu'est ce que j'ai raté ,


    cordialement

  6. #46
    Expert éminent
    Avatar de Oliv-
    Homme Profil pro
    solution provider
    Inscrit en
    mars 2006
    Messages
    4 081
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Nord (Nord Pas de Calais)

    Informations professionnelles :
    Activité : solution provider

    Informations forums :
    Inscription : mars 2006
    Messages : 4 081
    Points : 7 033
    Points
    7 033
    Billets dans le blog
    20
    Par défaut
    PartieNom est 'il bien défini ?

  7. #47
    Nouveau membre du Club
    Homme Profil pro
    Getion appro planning
    Inscrit en
    août 2020
    Messages
    35
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 61
    Localisation : France, Bas Rhin (Alsace)

    Informations professionnelles :
    Activité : Getion appro planning
    Secteur : Industrie

    Informations forums :
    Inscription : août 2020
    Messages : 35
    Points : 35
    Points
    35
    Par défaut
    Bonjour,

    c'est pire qu'une enquête policier un vrais roman policier, tout y est enquête, recherche, intrigue, et enfin le coupable,

    je crois comprendre ce qui se passe, en fait mes RDV ont comme titre "Status-Equipe" plus tard le titre sera plus complexe "Status-Equipe 1" etc...
    du coup je souhaite supprimer tous les RDV qui comporte une partie du nom (du Titre) soit "PartieNom" = "tatus-Equip"
    seulement dans la recherche le code recherche tous les RDV qui on comme titre "tatus-Equip" c'est donc normal qu'il ne trouve rien,

    pour tester j'ai changé la ligne 15 en ceci avec le titre complet et ca marche il trouve bien tous les RDV avec ce titre, de plus j'ai du ajouter les simple guillemets:
    sFilter = "@SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0037001E" _
    & Chr(34) & " ci_phrasematch " & "'Status-Equipe'"


    donc comment je fait pour rechercher tous les RDV dont le titre contient "PartieNom" (soit "tatus-Equip") N?

    je met le code complet:
    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
    32
    33
    34
    35
    36
    37
    38
    39
    'Test avec restrict
    'cette version supprime les RDV sur tous les calendriers qui sont selectionnés (RDV sans destinataire!!!???)
    Sub SupprimeCalendrierPartag?4() 'supprime les RDV qui sont dans le calendrier nomm? dans "ObjNavCalPart" et "monCalendrier"
    Dim OlFolder As Outlook.MAPIFolder
    Dim OlAppointment As Outlook.AppointmentItem
    Dim ObjNS As Outlook.Namespace
    Dim ObjExpCal As Outlook.Explorer
    Dim ObjNavMod As Outlook.CalendarModule
    Dim ObjNavCalPart As Outlook.NavigationFolders
    Dim i, objitem As Object
    Dim subject As String
    Dim PartieNom As String
    Dim PlanningNom As String
     
    Sheets("donn?es").Select
    PartieNom = "tatus-Equip"
    c = "Status-Equipe"
     
    Set ol = CreateObject("outlook.application") 'on se connecte ? outlook
    Set ObjNS = ol.Session 'on se connect ? la session
    Set ObjExpCal = ObjNS.GetDefaultFolder(olFolderCalendar).GetExplorer 'on recherche le calendrier par defautl et on ouvre un EXPLORER (une fenetre OUTLOOK sur les calendriers)
    Set ObjNavMod = ObjExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar) 'on se positionne dans la partie CALENDRIER (colonne de gauche )
    Set objcalgr = ObjNavMod.NavigationGroups.Item("Tous les calendriers de groupe") 'ici on selectionne le groupe
    Set ObjNavCalPart = ObjNavMod.NavigationGroups.Item("Tous les calendriers de groupe").NavigationFolders 'on se positionne dans la collection de calendriers de cette section
    Set monCalendrier = ObjNavCalPart("Planning Technique") 'ensuite il faut en s?lectionner 1 par son nom par exemple
    Set OlFolder = monCalendrier.Folder ' et si on veut parcourir ce calendrier il faut retrouver le FOLDER correspondant
     
        sFilter = "@SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0037001E" _
        & Chr(34) & " ci_phrasematch " & "'Status-Equipe'"
     
        Set OlAppointmentS = OlFolder.Items.Restrict(sFilter)
           'Parcourir les cellules de la colonne B de la ligne 2 ? la derni?re ligne occup?
        For ii = OlAppointmentS.Count To 1 Step -1 'compteur a l'envers
        Set OlAppointment = OlAppointmentS(ii)
            If OlAppointment.subject Like ("*" & PartieNom & "*") Then OlAppointment.Delete 'selection et suppression
            'If OlAppointment.subject = c Then OlAppointment.Delete
            Set OlAppointment = Nothing 'on vide la memoire
            Next
    End Sub
    cordialement

    suite 1


    en fouillant j'ai trouvé ceci sur un autre poste: merci à gonsp
    ça a l'aire de fonctionner
    qu'en pensez vous ?
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    Const PropTag  As String = "http://schemas.microsoft.com/mapi/proptag/"
         sFilter = "@SQL=" & Chr(34) & PropTag & "0x0037001E" & Chr(34) & " like '%tatus-Equip%'"
    reste plus qu'a remplacer '%tatus-Equip%' par PartieNom pour avoir une variable

    suite 2
    a tout hasard j'ai tenté votre code en supprimant "ci_phrasematch " et ca fonctionne aussi,

    il me reste donc ceci:
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    sFilter = "@SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0037001E" _
        & Chr(34) & " like '%tatus-Equip%'"

    pour vous c'est quoi la meilleur solution ? la plus fiable ?

    reste plus qu'a remplacer '%tatus-Equip%' par PartieNom pour avoir une variable

    suite 3
    je pense que c'était une histoire de guillemets:

    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    sFilter = "@SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0037001E" _
        & Chr(34) & " Like '%" & PartieNom & "%'"

    le code complet:

    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
    32
    33
    34
    35
    Sub SupprimeCalendrierPartag?4() 'supprime les RDV qui sont dans le calendrier nomm? dans "ObjNavCalPart" et "monCalendrier"
    Dim OlFolder As Outlook.MAPIFolder
    Dim OlAppointment As Outlook.AppointmentItem
    Dim ObjNS As Outlook.Namespace
    Dim ObjExpCal As Outlook.Explorer
    Dim ObjNavMod As Outlook.CalendarModule
    Dim ObjNavCalPart As Outlook.NavigationFolders
    Dim i, objitem As Object
    Dim subject As String
    Dim PartieNom As String
    Dim PlanningNom As String
     
    Sheets("donn?es").Select
    PartieNom = "tatus-Equip"
    c = "Status-Equipe"
     
    Set ol = CreateObject("outlook.application") 'on se connecte ? outlook
    Set ObjNS = ol.Session 'on se connect ? la session
    Set ObjExpCal = ObjNS.GetDefaultFolder(olFolderCalendar).GetExplorer 'on recherche le calendrier par defautl et on ouvre un EXPLORER (une fenetre OUTLOOK sur les calendriers)
    Set ObjNavMod = ObjExpCal.NavigationPane.Modules.GetNavigationModule(olModuleCalendar) 'on se positionne dans la partie CALENDRIER (colonne de gauche )
    Set objcalgr = ObjNavMod.NavigationGroups.Item("Tous les calendriers de groupe") 'ici on selectionne le groupe
    Set ObjNavCalPart = ObjNavMod.NavigationGroups.Item("Tous les calendriers de groupe").NavigationFolders 'on se positionne dans la collection de calendriers de cette section
    Set monCalendrier = ObjNavCalPart("Planning Technique") 'ensuite il faut en s?lectionner 1 par son nom par exemple
    Set OlFolder = monCalendrier.Folder ' et si on veut parcourir ce calendrier il faut retrouver le FOLDER correspondant
        sFilter = "@SQL=" & Chr(34) & "http://schemas.microsoft.com/mapi/proptag/0x0037001E" _
        & Chr(34) & " Like '%" & PartieNom & "%'"
        Set OlAppointmentS = OlFolder.Items.Restrict(sFilter)
           'Parcourir les cellules de la colonne B de la ligne 2 ? la derni?re ligne occup?
        For ii = OlAppointmentS.Count To 1 Step -1 'compteur a l'envers
        Set OlAppointment = OlAppointmentS(ii)
            If OlAppointment.subject Like ("*" & PartieNom & "*") Then OlAppointment.Delete 'selection et suppression
            'If OlAppointment.subject = c Then OlAppointment.Delete
            Set OlAppointment = Nothing 'on vide la memoire
            Next
    End Sub
    si vous pouviez verifier que le code est propre,


    suite 4

    est ce que Application.ScreenUpdating = False apporte quelque chose ?


    cordialement

Discussions similaires

  1. Export Calendrier Outlook
    Par KIXE80 dans le forum VBA Outlook
    Réponses: 16
    Dernier message: 04/07/2020, 20h54
  2. [XL-2010] Exporter Calendrier Outlook
    Par omarter dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 16/01/2015, 17h34
  3. Réponses: 0
    Dernier message: 14/04/2013, 21h16
  4. Afficher le calendrier outlook depuis une applications windows form
    Par vb_programmeur dans le forum Windows Forms
    Réponses: 1
    Dernier message: 08/12/2010, 13h16
  5. [MySQL] Exporter des données vers Excel depuis php
    Par berti dans le forum PHP & Base de données
    Réponses: 4
    Dernier message: 05/03/2008, 14h26

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo