Discussion :

[LalaGirl]

Bonjour à tous,

Je cherche de l'aide pour écrire un code.
Mes prérequis en excel sont les suivants : Je me suis mise à excel et vba il y a 3 semaines !

Pour un projet pour mes études, je dois créer un fichier qui créer des rdv dans Outlook, ça j'ai réussi.
ce même fichier doit pouvoir supprimer les rendez-vous.
Les rendez-vous créé par ce code rempli une cellule "RDV Créé" . L'idée serait que quand il y a rendez-vous créé, on puisse les effacer dans outlook quand on sélectionne "Nettoyer les alertes" dans le menu déroulant en N1. Puis qu'il efface les cellules ou est indiqué rendez-vous créé.

Tous les rendez-vous qui ont été créé doivent être supprimés, sans distinction.

dans les faits, voici comment sa se passe : quand on utilise le fichier, c'est pour des dossiers sur lesquels on ne doit pas oublier des etapes, donc le fichier permet de creer des rendez-vous en fonction de certains critères. Mais parfois le dossier tombe a l'eau. il faut donc qu'on nettoie complètement l'agenda.

Si quelqu'un veut bien jeter un oeil au code du module 3 pour m'aider, ce serait super.

D'avance merci

fichier-essai-out.xlsm

Lila

[Qwazerty]

Salut

Qu'est ce qui ne fonctionne pas?

J'avais commencé à modifier un fichier qui faisait un truc similaire au boulot, je n'ai pas prit le temps de finir mais j'avais pensé mettre un numéro unique dans le corps du rdv (une valeur hexadécimal de 10 caractères par exemple, généré aléatoirement) pour identifier avec certitude le rdv à supprimer.

[Edit]
Je viens de faire un test avec l'ordi du boulot (j'ai plus Outlook sur le perso).

Il faut faire attention à la casse "RDV créé" <> de "RDV Créé".
Quatre méthodes,

• soit t'assurer de respecter la casse. Attention si la base de donnée peut-être modifié à la main
• soit passer les textes en majuscule ou en minuscule lors du test
• soit utiliser strcomp() qui permet de choisir entre une comparaison textuelle ou au niveau bit
• soit noter tout au début du module de code "Option Compare Text". Toutes les comparaisons du module se feront au niveau textuel, donc sans tenir compte de la casse... attention donc.

Un conseil, évite autant que possible les caractères accentués dans les noms de variables

Pour l'identification du message, il y a peut-être "ConversationId" et/ou "Conversation Index". Je vais regarder ça pourra m'être utile

Voila les modifications

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
'https://www.developpez.net/forums/d2130473/logiciels/microsoft-office/excel/macros-vba-excel/supprimer-rendez/#post11834068Sub REUNION_SABLIER()
Dim OlApp As Outlook.Application
Dim olAppItem As Outlook.AppointmentItem
Dim DEBUT, FIN, L&, LR&
Set OlApp = CreateObject("Outlook.Application")
 
 
'Il vaut mieux préciser le classeur sur lequel tu travailles
'With ThisWorkbook.Worksheets("Feuil1")
'Ou plus simplement utiliser le codename de la feuille
With Feuil1
    LR = .Cells(.Rows.Count, 14).End(xlUp).Row
    For L = 23 To 194
 
        'Pour faciliter la lecture/modification du code, Cells accepeter les nom de colonne en lettre 'je ne modifie pas tout
        If .Cells(L, "W") <> "" And .Cells(L, "O") = "" Then
 
 
            DEBUT = DateValue(.Cells(L, "W")) + .Cells(L, 17)
 
 
            FIN = DateValue(.Cells(L, "W")) + .Cells(L, 18)
 
 
            Set olAppItem = OlApp.CreateItem(olAppointmentItem)
            With olAppItem
                .Body = Feuil1.Cells(L, 21)
                .ReminderSet = True
                .BusyStatus = olFree
                .Start = DEBUT
                .End = FIN
                .Subject = Feuil1.Cells(L, 19)
 
 
                .Save
            End With
            .Cells(L, 15) = "RDV créé"
            .Cells(L, 14).Value = olAppItem.ConversationIndex
        End If
    Next L
End With
Set olAppItem = Nothing
Set OlApp = Nothing
End Sub

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
'https://www.developpez.net/forums/d2130473/logiciels/microsoft-office/excel/macros-vba-excel/supprimer-rendez/#post11834068Sub supp_rdv()
 
 
    Dim OlApp As New Outlook.Application
    Dim calendrier As Outlook.Folder
    Dim rdvs_trouvés As Outlook.Items
    Dim rdv As Outlook.AppointmentItem
    Dim filtre As String
    Dim DEBUT As Date, FIN As Date, date_rech As Date
    Dim L As Integer
 
 
    '//création application
    Set OlApp = Outlook.Application
 
 
    '//affectation calendrier par défaut
    Set calendrier = OlApp.Session.GetDefaultFolder(olFolderCalendar)
 
 
    '//traitement
    With Feuil1
        For L = 23 To 194
 
 
            If .Cells(L, 23) <> "" And .Cells(L, 15) = "RDV créé" Then
 
                'affectation début et fin du rdv
                DEBUT = DateValue(.Cells(L, 23)) + .Cells(L, 17)
                FIN = DateValue(.Cells(L, 23)) + .Cells(L, 18)
 
 
                'recherche des rdvs correspondant à la date de début
                date_rech = DEBUT
                filtre = "[Start] > '" & Format(date_rech - 1, "ddddd") & "'" & "And" & "[Start] < '" & Format(date_rech + 1, "ddddd") & "'"
                Set rdvs_trouvés = calendrier.Items.Restrict(filtre)
                'suppression des rdvs trouvés si correspondance avec début et fin
                For Each rdv In rdvs_trouvés
                    'On vérifie l'Id du RDV
                    If rdv.ConversationIndex = .Cells(L, "N").Value Then rdv.Delete
                Next rdv
 
            End If
        Next L
   End With
 
 
    Set OlApp = Nothing
 
 
 
End Sub

Un autre conseil, tu pourrais passer ton tableau où tu stock tes rdv en tableau structuré, tu trouveras des tutoriels sur le site (Rédacteur Pierre Fauconnier entre autre). C'est rien à faire et ça te simplifie la vie (il faut modifier un peu le code par contre).

[/Edit]

++
Qwaz