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
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
| Public Function ImportRendezVous()
'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
Dim olkTsk As Outlook.TaskItem
Dim olkPat As Outlook.RecurrencePattern '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
Set rp = ai.GetRecurrencePattern
'Set op = rp.GetOccurrence(cfdebut)
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
If ai.Recipients.Count > 0 Then
For i = 1 To ai.Recipients.Count
cfrec = cfrec & ai.Recipients.Item(i) & ";"
Next i
End If
cfsens = ai.Sensitivity
cfbs = ai.BusyStatus
rpendt = rp.EndTime
rpdura = rp.Duration
rpdwm = ConvertDaysOfWeekMask(rp.DayOfWeekMask)
If rp.Exceptions.Count > 0 Then
For i = 1 To rp.Exceptions.Count
rpexecp = rpexecp & rp.Exceptions.Item(i) & ";"
Next i
End If
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
rpp = rp.Parent
'sSQLInsert = "INSERT INTO " & MaTable & " ([Sujet],[Debut],[Fin],[Lieu],[Categorie],[Status reccurence] ,[Rappel] , [BRappel] , [Journee entiere] , [Description], [Companies associer] , [Duree] , [Identificateur entree] , [Identificateur global] , [Importance] , [RDV reccurent] , [Participant facultatif] , [Organisateur] , [Destinataire] , [Critere diffusion] , [Disponibilite]) VALUES ( '" & cfsubject & "','" & cfdebut & "','" & cffin & "','" & cflieu & "','" & cfcat & "', '" & cfrecur & "','" & cfreminstart & "', '" & cfremin & "' ,'" & cfallday & "', '" & cfbody & "', '" & cfcomp & "', '" & cfdur & "', '" & cfenid & "', '" & cfgaid & "', '" & cfimp & "', '" & cfirec & "', '" & cfoa & "', '" & cforg & "', '" & cfrec & "', '" & cfsens & "' )"
'sSQLInsert2 = "INSERT INTO " & MaTable2 & " ([Jours semaine] ,[Duree] ,[Heure fin periodicite] , [Execptions] , [Duree periodicite] , [Interval] ,[Mois periodicite] ,[Sans fin] ,[Nb occurrences] ,[Date fin periodicite] ,[Date debut periodicite] ,[Periodicite] ,[Heure debut periodicite] ,[Parent]) VALUES ( '" & rpdwm & "','" & rpdura & "','" & rpendt & "','" & rpexecp & "','" & rpinst & "', '" & rpinter & "','" & rpmoy & "', '" & rpned & "' ,'" & rpoccu & "', '" & rpped & "', '" & rppsd & "', '" & rprt & "', '" & rpst & "', '" & rpp & "')"
sSQLInsert2 = "INSERT INTO " & MaTable2 & " ([Jours semaine] ,[Duree] ,[Heure fin periodicite]) VALUES ( '" & rpdwm & "'," & rpdura & ",#" & Format(rpendt, "hh:nn:ss") & "#)"
'requete insert
'db.Execute sSQLInsert, dbFailOnError
db.Execute sSQLInsert2, dbFailOnError
'enregistrement suivant
Next
Set ai = Nothing
Set cf = Nothing
Set ns = Nothing
olApp.Quit
Set olApp = Nothing
Set myrst = Nothing
db.Close
End Function
Function ConvertDaysOfWeekMask(intMask As Integer) As String
If intMask And olSunday Then
ConvertDaysOfWeekMask = ConvertDaysOfWeekMask & "Sun,"
End If
If intMask And olMonday Then
ConvertDaysOfWeekMask = ConvertDaysOfWeekMask & "Mon,"
End If
If intMask And olTuesday Then
ConvertDaysOfWeekMask = ConvertDaysOfWeekMask & "Tue,"
End If
If intMask And olWednesday Then
ConvertDaysOfWeekMask = ConvertDaysOfWeekMask & "Wed,"
End If
If intMask And olThursday Then
ConvertDaysOfWeekMask = ConvertDaysOfWeekMask & "Thu,"
End If
If intMask And olFriday Then
ConvertDaysOfWeekMask = ConvertDaysOfWeekMask & "Fri,"
End If
If intMask And olSaturday Then
ConvertDaysOfWeekMask = ConvertDaysOfWeekMask & "Sat,"
End If
If Len(ConvertDaysOfWeekMask) > 0 Then
ConvertDaysOfWeekMask = Left(ConvertDaysOfWeekMask, Len(ConvertDaysOfWeekMask) - 1)
End If
End Function |
Import de rendez-vous Outlook dans Access
Répondre avec citation
) je dispose d'un calendrier partager ( de mon compte google) en abonnement, je voudrais savoir comment faire pour importer aussi les données de ce calendrier. 
, mais il me semble qu'au niveau du sql, les variables que tu utilises doivent être formatées différemment en fonction de leur type. 
Envoyé par JRTConcept
Partager