1 pièce(s) jointe(s)
VBA création de rdv dans outlook depuis Excel si le rdv n'existe pas déjà
Bonjour,
Je fais une macro pour générer des rdv dans outlook depuis des dates et infos d'un fichier excel,
J'y arrive (merci internet !) mais le souci est qu'à chaque fois que j'exécute la macro pour tester, je me mets plusieurs fois le même rdv dans outlook.
Sauriez-vous svp comment je pourrai tester si le rdv existe déjà à la date pour ne pas le créer de nouveau ?
Ou le supprimer par macro avant de le créer ?
voici un extrait de mon fichier :
Pièce jointe 628441
et voici "mon" code :
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
|
Option Explicit
Sub AddAppointments()
Dim myoutlook As Object ' Outlook.Application
Dim r As Long
Dim myapt As Object ' Outlook.AppointmentItem
Dim daterdv As Date
' late bound constants
Const olAppointmentItem = 1
Const olBusy = 2
Const olMeeting = 1
' Create the Outlook session
Set myoutlook = CreateObject("Outlook.Application")
' Start at row 2
r = 2
Do Until Trim$(Cells(r, 1).Value) = ""
' Create the AppointmentItem
Set myapt = myoutlook.CreateItem(olAppointmentItem)
' Set the appointment properties
With myapt
.Subject = Cells(r, 1).Value
.Start = Cells(r, 3).Value & " 9:00"
.End = Cells(r, 3).Value & " 10:00"
.Recipients.Add Cells(r, 4).Value
.MeetingStatus = olMeeting
.Body = "RDV POUR " & Cells(r, 1).Value
.Save
r = r + 1
.Send
End With
Loop
End Sub |
