Discussion :

[GADENSEB]

Bonsoir le Forum,
J'ai une macro qui ne fonctionne plus !!! grrrr

cette macro me permettait de générer des rdv dans mon GoogleAgenda....

Mais là elle ne veut plus marcher.....

Schéma :
La date est passée au format GoogleAgenda puis création du rdv puis flag.

La modif de la date et le flag marche nikel, mais de création de rdv dans GoogleAgenda


Si qqn à une idée, je suis preneur !!

Bonne soirée
Seb

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
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
Dim i, j As Integer
 
Sub GoogleAgenda()
 
 
With Worksheets("RDV")
 
 
 
 
On Error Resume Next
j = .Range("A2").End(xlDown).Row
For i = 2 To j
 
 
'Convertit la DATERELANCE en Format de DATE pour GOOGLEAGENDA
.Cells(i, "D") = "'" & Format(.Cells(i, "C"), "yyyy-mm-dd")
 
 
 
If .Cells(i, 5) <> "ok" And .Cells(i, 4) <> "" Then
 
'================================== PARAMETRES GOOGLE AGENDA ==================================
Email = "XXXXXXXXXXXXXXXXXXXXXXX"
Passwd = "XXXXXXXXXXXXXXXXXXXX"
authUrl = "https://www.google.com/accounts/ClientLogin"
CALENDARURL = "http://www.google.com/calendar/feeds/default/private/full"
MAILINVITE = "XXXXXXXXXXXXXXXXXXXXX"
LIEU = "XXXXXXXXXXXXXXXXXXXXX"
 
 
sujet = Range("C" & i).Value & " - " & Range("AF" & i).Value
DESCRIPTIONRDV = Range("AF" & i).Value
NOMINVITE = "Agenda Emploi"
DATEDEBUT = Range("AP" & i).Value & "T14:00:00.000Z"
DATEFIN = Range("AP" & i).Value & "T15:15:00.000Z"
 
 
 
'================================== CREATION D'UN EVENEMENT ==================================
calendarEntry = "<?xml version='1.0' ?><entry xmlns='http://www.w3.org/2005/Atom' " _
& "xmlns:gd='http://schemas.google.com/g/2005'>" _
& "<category scheme='http://schemas.google.com/g/2005#kind' " _
& "term='http://schemas.google.com/g/2005#event'></category>" _
& "<title type='text'>" & sujet & "</title>" _
& "<content type='text'>" & DESCRIPTIONRDV & "</content>" _
& "<author>" _
& "<name>" & NOMINVITE & "</name>" _
& "<email>" & MAILINVITE & "</email>" _
& "</author>" _
& "<gd:transparency " _
& "value='http://schemas.google.com/g/2005#event.opaque'>" _
& "</gd:transparency>" _
& "<gd:eventStatus " _
& "value='http://schemas.google.com/g/2005#event.confirmed'>" _
& "</gd:eventStatus>" _
& "<gd:where valueString='" & LIEU & "'></gd:where>" _
& "<gd:when startTime='" & DATEDEBUT & "' " _
& "endTime='" & DATEFIN & "'></gd:when>" _
& "</entry>"
 
'================================== AUTHENTIFICATION ==================================
Set objHTTP = CreateObject("Microsoft.XMLHTTP")
objHTTP.Open "POST", authUrl, False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.send "Email=" + Email + "&Passwd=" + Passwd + "&service=cl&source=Gulp-CalGulp-1.05"
strAuthTokens = objHTTP.responseText
strAuthTokens = Replace(strAuthTokens, vbCr, "")
strAuthTokens = Replace(strAuthTokens, vbLf, "")
strAuthTokens = Replace(strAuthTokens, vbCrLf, "")
strAuthTokens = Replace(strAuthTokens, "SID", "&SID", 1, 1)
strAuthTokens = Replace(strAuthTokens, "LSID", "&LSID")
strAuthTokens = Replace(strAuthTokens, "Auth", "&Auth")
strAuthTokens = Right(strAuthTokens, Len(strAuthTokens) - Len("Auth=") - InStr(strAuthTokens, "Auth=") + 1)
Set objHTTP = Nothing
 
'================================== REDIRECT ==================================
Set objHTTP = CreateObject("Microsoft.XMLHTTP")
objHTTP.Open "POST", CALENDARURL, False
objHTTP.setRequestHeader "Content-Type", "application/atom+xml"
objHTTP.setRequestHeader "X-If-No-Redirect", "True"
objHTTP.setRequestHeader "Authorization", "GoogleLogin auth=" & strAuthTokens
objHTTP.send calendarEntry
'objHTTP.status should be 412
 
'================================== POST TO THE NEW URL ==================================
headers = objHTTP.getAllResponseHeaders()
strResponse = objHTTP.responseText
redirectStringPos = InStr(headers, "X-Redirect-Location:")
redirectStringLength = InStr(InStr(headers, "X-Redirect-Location:"), headers, vbCrLf) - InStr(headers, "X-Redirect-Location:")
redirectUrl = Replace(Mid(headers, redirectStringPos, redirectStringLength), "X-Redirect-Location: ", "")
 
Set objHTTP = CreateObject("Microsoft.XMLHTTP")
objHTTP.Open "POST", redirectUrl, False
objHTTP.setRequestHeader "Authorization", "GoogleLogin auth=" & strAuthTokens
objHTTP.setRequestHeader "Content-Type", "application/atom+xml"
objHTTP.send calendarEntry
'objHTTP.status should be 201
 
 
If objHTTP.Status = 201 Then
   MsgBox "Event saved"
Else
    MsgBox objHTTP.Status
 
 
 
End If
.Cells(i, 5) = "OK"
Next
 
End With
 
End Sub

[GADENSEB]

bonjour

C'est de l'API Google agenda v2, je viens de trouver que cette version du code à été stoppée par Google pour passer à la V3 mi-novembre donc ce code ne marchera donc plus effectivement, je vais clôturer le sujet

Je dois donc bûcher pour passer à GoogleAPI calendar V3

--> Si vous connaissez une bonne méthode (simple et rapide) pour synchroniser mon google agenda avec une feuille excel je suis preneur !!! cela fait un an que je cherche et je ne trouve pas ...


Merci par avance

[yannick26100]

bonjour

C'est de l'API Google agenda v2, je viens de trouver que cette version du code à été stoppée par Google pour passer à la V3 mi-novembre donc ce code ne marchera donc plus effectivement, je vais clôturer le sujet

Je dois donc bûcher pour passer à GoogleAPI calendar V3

--> Si vous connaissez une bonne méthode (simple et rapide) pour synchroniser mon google agenda avec une feuille excel je suis preneur !!! cela fait un an que je cherche et je ne trouve pas ...


Merci par avance

bonjour

Desolé de relancer ce sujet mais auriez vous trouver une nouvelle macro qui prend en charge GoogleAPI calendar Actuel

merci pour votre réponse