Discussion :

[lechtifred]

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 :

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

Grâ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
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 :

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

Merci

[Fvandermeulen]

Salut,

En fait c'est ta variable Cell qui te permet de récupérer la valeur qui alimentra test1.

J'ai pas essayé, mais ça devrait donner ça, si ça ne fonctionne pas il faut jouer avec les "

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
 
For Each Cell In Range("A8:A" & Range("A22").End(xlUp).Row)
     Test1 = "" & cell.Value & ""
' Recherche dans le calendrier selon le sujet
Set MyTask = MyTasks.Find("[subject] = " & Test1 & "")
If MyTask Is Nothing Then
 'Création du rendez vous, ton code initial
Else
 'Modification du rendez vous, voir le dernier code que j'avais posté sur l'autre discussion.
...

A+