Excel / Gmail / Création de RDV

GADENSEB

XLDnaute Impliqué
Bonjour le Forum,
cela faisait un moment !!!

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


Dim i, j As Integer

Code:
Sub GOOGLEAGENDA()


With Worksheets("BASE EMPLOI")



'Convertit la DATERELANCE en Format de DATE pour GOOGLEAGENDA
j = .Range("A2").End(xlDown).Row
For i = 2 To j
.Cells(i, "D") = "'" & Format(.Cells(i, "C"), "yyyy-mm-dd")




On Error Resume Next
j = .Range("A2").End(xlDown).Row

'For i = 2 To j
If .Cells(i, 5).Value <> "OK" And .Cells(i, 4).Value <> "" Then




'================================== PARAMETRES GOOGLE AGENDA ==================================
Email = "xxxxxxxxxxxxxxx"
Passwd = "xxxxxxxxxxxxxxxxxxxxxx"
authUrl = "https://www.google.com/accounts/ClientLogin"
CALENDARURL = "http://www.google.com/calendar/feeds/default/private/full"
MAILINVITE = "xxxxxxxxxxxxxxxxxxxxxxxxxxxx"
LIEU = "xxxxxxxxxxxxxxxxxxxxxxxxxxx"



Sujet = Range("A" & i).Value & " - " & Range("B" & i).Value
DESCRIPTIONRDV = Range("B" & i).Value
NOMINVITE = "Agenda Emploi"
DATEDEBUT = Range("D" & i).Value & "T14:00:00.000Z"
DATEFIN = Range("D" & 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"
'End If


.Cells(i, 5).Value = "OK"
End If


Next


End With


End Sub
 

Pièces jointes

  • GENERER RDV GMAIL.xlsm
    23.8 KB · Affichages: 35

GADENSEB

XLDnaute Impliqué
Re : Excel / Gmail / Création de RDV

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
 

Statistiques des forums

Discussions
311 725
Messages
2 081 939
Membres
101 844
dernier inscrit
pktla