Problème VBA avec le mytask sur la lecture de calendrier outlook

Bonjour,

Je rencontre un problème avec la syntaxe my task.

J’utilise un code VBA permettant de mettre à jour mon calendrier outlook via un fichier Excel.Or lorsque que je modifie une date pour redéfinir un rendez vous, je rencontre des doublons.

Voici mon

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
Sub NouveauRDV_Calendrier()
'nécéssite d'activer la référence Microsoft Outlook 10.0 Object Library
Dim myOlApp As New Outlook.Application
Dim MyItem As Outlook.AppointmentItem
Dim Cell As Range
 
For Each Cell In Range("A8:A" & Range("A22").End(xlUp).Row)
    Set MyItem = myOlApp.CreateItem(olAppointmentItem)
 
    With MyItem
        .MeetingStatus = olNonMeeting
        .Subject = Cell
        .Start = Cell.Offset(0, 1) ' Attention : format mm/dd/yy
        .Duration = Cell.Offset(0, 2) 'minutes
        .Location = Cell.Offset(0, 3)
        .Save
    End With
 
    Set MyItem = Nothing
Next Cell
 
End Sub

Grâce à l’information de Fvandermeulen.j’arrive à retrouver manuellement.

Code:

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
Sub RechercheCalendrier()
 
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set myFolder = olns.GetDefaultFolder(olFolderCalendar)
Set MyTasks = myFolder.Items
 
' Recherche dans le calendrier selon le sujet
Set MyTask = MyTasks.Find("[subject] = ""RDV Mr X""")
If MyTask Is Nothing Then ' Si non trouvé
   MsgBox "Pas de rendez vous prévu"
Else
   MsgBox "Rendez vous prévu le " & MyTask.Start
       With MyTask
        .MeetingStatus = olNonMeeting
        .Subject = "RDV Mr Y"
        .Save
    End With
 
End If
 
Set ol = Nothing
Set olns = Nothing
Set myFolder = Nothing
Set MOnSujet = Nothing
 
End Sub

Maintenant je voudrai effectuer la fusion des 2 codes.Mais j’ai des problèmes avec la systaxe My task.

Mettre à la place de test1 le range de la cell ,me permettant de tourner en boucle entre A8 et A22.lors de la scrutation si le rendez-vous excite je passe outre, sinon j’effectue le transfert.

Code:

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
Sub RechercheCalendrier()
Dim myOlApp As New Outlook.Application
Dim MyItem As Outlook.AppointmentItem
Dim Cell As Range
 
 
Set ol = New Outlook.Application
Set olns = ol.GetNamespace("MAPI")
Set myFolder = olns.GetDefaultFolder(olFolderCalendar)
Set MyTasks = myFolder.Items
line:
For Each Cell In Range("A8:A" & Range("A22").End(xlUp).Row)
 
 
' Recherche dans le calendrier selon le sujet
Set MyTask = MyTasks.Find("[subject] = ""test1""")
If MyTask Is Nothing Then ' Si non trouvé
   MsgBox "Pas de rendez vous prévu"
Else
   'MsgBox "Rendez vous prévu le " & MyTask.Start
    '   With MyTask
     '   .MeetingStatus = olNonMeeting
      '  .Subject = "RDV Mr Y"
       ' .Save
    'End With
 'For Each Cell In Range("A8:A" & Range("A22").End(xlUp).Row)
    Set MyItem = myOlApp.CreateItem(olAppointmentItem)
 
    With MyItem
        .MeetingStatus = olNonMeeting
        .Subject = Cell
        .Start = Cell.Offset(0, 1) ' Attention : format mm/dd/yy
        .Duration = Cell.Offset(0, 2) 'minutes
        .Location = Cell.Offset(0, 3)
        .Save
    End With
 
    Set MyItem = Nothing
Next Cell
GoTo line
End If
 
Set ol = Nothing
Set olns = Nothing
Set myFolder = Nothing
Set MOnSujet = Nothing
 
End Sub

Merci