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
53
54
55
56
57
58
59
60
|
Sub Appointments()
Const olAppointmentItem As Long = 1
Dim OLApp As Object
Dim OLNS As Object
Dim OLAppointment As Object
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim Qte As Variant
Dim position As Variant
Dim myRequiredAttendee As Outlook.recipient
Set ws1 = Workbooks("Sales_Life_Cycle").Sheets("control_room")
Set ws2 = Workbooks("Sales_Life_Cycle").Sheets("Database_MW")
Qte = ws1.Range("C16")
position = ws1.Range("C33")
On Error Resume Next
Set OLApp = GetObject(, "Outlook.Application")
With ws2
.Cells(position, 34) = Format(.Cells(position, 34), "m/d/yyyy")
If OLApp Is Nothing Then Set OLApp = CreateObject("Outlook.Application")
On Error GoTo 0
If Not OLApp Is Nothing Then
Set OLNS = OLApp.GetNamespace("MAPI")
OLNS.Logon
Set OLAppointment = OLApp.CreateItem(olAppointmentItem)
OLAppointment.Subject = "test"
OLAppointment.Start = .Cells(position, 34).Value & " 14:00"
OLAppointment.Duration = 10
OLAppointment.ReminderMinutesBeforeStart = 15
OLAppointment.Location = "Not applicable"
OLAppointment.RequiredAttendees = "toto@gmail.com"
OLAppointment.ForceUpdateToAllAttendees = True
OLAppointment.Recipients.ResolveAll
OLAppointment.GetRecurrencePattern
With GetRecurrencePattern
.RecurrenceType = olRecursYearNth
.Instance = 1
.Occurrences = 3
End With
OLAppointment.Display
Set OLAppointment = Nothing
Set OLNS = Nothing
Set OLApp = Nothing
End If
End With
End Sub |
Problème récurrence pour envoi d'un meeting
Répondre avec citation
Envoyé par romainorleans
Partager