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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
Private Sub Commande21_Click()
'Outlook
Dim olApp As Outlook.Application
Dim ns As Outlook.NameSpace
Dim cf As Outlook.MAPIFolder
Dim ai As Outlook.AppointmentItem
Dim rp As Outlook.RecurrencePattern
Dim it As Outlook.Items
Dim op As Outlook.AppointmentItem
'SQL
Dim db As DAO.Database
Dim myrst As DAO.Recordset
MaTable = "RDVOutlook"
MaTable2 = "ReccurenceRDVOutlook"
'Rendez-vous
Dim cfsubject As Variant
Dim cfdebut As Date
Dim cffin As Date
Dim cflieu As Variant
Dim cfcat As Variant
Dim cfrecur As Variant
Dim cfreminstart As Variant
Dim cfremin As Boolean
Dim cfallday As Boolean
Dim cfbody As Variant
Dim cfcomp As Variant
Dim cfdur As Variant
Dim cfenid As Variant
Dim cfgaid As Variant
Dim cfimp As Variant
Dim cfirec As Boolean
Dim cfoa As Variant
Dim cforg As Variant
Dim cfrec As Variant
Dim cfsens As Variant
Dim cfbs As Variant
'Reccurrence des rendez-vous
Dim rpendt As Date
Dim rpdura As Variant
Dim rpdwm As Variant
Dim rpexep As Variant
Dim rpinst As Variant
Dim rpinter As Variant
Dim rpned As Boolean
Dim rpoccu As Variant
Dim rpped As Date
Dim rppsd As Date
Dim rpst As Date
Dim rprt As Variant
Dim rpp As Variant
Set db = CurrentDb
Set olApp = CreateObject("Outlook.Application")
Set ns = olApp.GetNamespace("MAPI")
Set cf = ns.GetDefaultFolder(olFolderCalendar)
Set it = cf.Items
For Each ai In cf.Items
cfsubject = ai.Subject
cfdebut = ai.Start
cffin = ai.end
cflieu = ai.location
cfcat = ai.Categories
cfrecur = ai.RecurrenceState
cfreminstart = ai.ReminderMinutesBeforeStart
cfremin = ai.ReminderSet
cfallday = ai.AllDayEvent
cfbody = ai.body
cfcomp = ai.Companies
cfdur = ai.duration
cfenid = ai.EntryID
cfgaid = ai.GlobalAppointmentID
cfimp = ai.Importance
cfirec = ai.IsRecurring
cfoa = ai.OptionalAttendees
cforg = ai.Organizer
cfsens = ai.Sensitivity
cfbs = ai.BusyStatus
Set ait = it(cfsubject)
Set rp = ait.GetRecurrencePattern
rpendt = rp.EndTime
rpdura = rp.duration
rpdwm = rp.DayOfWeekMask
rpinst = rp.Instance
rpinter = rp.Interval
rpmoy = rp.MonthOfYear
rpned = rp.NoEndDate
rpoccu = rp.Occurrences
rpped = rp.PatternEndDate
rppsd = rp.PatternStartDate
rpst = rp.StartTime
rprt = rp.RecurrenceType
sSQLInsert = "INSERT INTO " & MaTable & " ([Sujet],[Debut],[Fin],[Lieu],[Categorie],[Statut recurrence] ,[Rappel] , [BRappel] , [Journee entiere] , [Description], [Companies associer] , [Duree] , [Identificateur entree] , [Identificateur global] , [Importance] , [RDV reccurent] , [Participant facultatif] , [Organisateur] , [Critere diffusion] , [Disponibilite]) VALUES ( '" & cfsubject & "','" & cfdebut & "','" & cffin & "','" & cflieu & "','" & cfcat & "', '" & cfrecur & "','" & cfreminstart & "', '" & cfremin & "' ,'" & cfallday & "', '" & cfbody & "', '" & cfcomp & "', '" & cfdur & "', '" & cfenid & "', '" & cfgaid & "', '" & cfimp & "', '" & cfirec & "', '" & cfoa & "', '" & cforg & "','" & cfsens & "','" & cfbs & "' )"
sSQLInsert2 = "INSERT INTO " & MaTable2 & " ([Jours semaine] ,[Duree] ,[Heure fin periodicite] , [Duree periodicite] , [Interval] ,[Mois periodicite] ,[Sans fin] ,[Nb occurrence] ,[Date fin periodicite] ,[Date debut periodicite] ,[Periodicite] ,[Heure debut periodicite] ) VALUES ( '" & rpdwm & "','" & rpdura & "','" & rpendt & "','" & rpinst & "', '" & rpinter & "','" & rpmoy & "', '" & rpned & "' ,'" & rpoccu & "', '" & rpped & "', '" & rppsd & "', '" & rprt & "', '" & rpst & "')"
'requete insert
db.Execute sSQLInsert, dbFailOnError
db.Execute sSQLInsert2, dbFailOnError
'enregistrement suivant
Next
Set cf = Nothing
Set ns = Nothing
Set olApp = Nothing
Set myrst = Nothing
db.Close
End Sub |
