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 monGrâce à l’information de Fvandermeulen.j’arrive à retrouver manuellement.
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 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
Maintenant je voudrai effectuer la fusion des 2 codes.Mais j’ai des problèmes avec la systaxe My task.
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 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
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.
Merci
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 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
Partager