Base de données / Google Agenda /Gestion de Rendez-vous / Pièce jointe

GADENSEB

XLDnaute Impliqué
Bonjour,
Je monte une bdd, qui dois gérer les rdv (faire des rappels) sous mon GoogleAgenda.

- J'ai une colonne '"DATE DE RELANCE" en colonne AK
- Il me manque une heure dans une colonne ?
- Je dois générer les rdv dans un agenda "EMPLOI"
- Je cherche à rajouter un fichier pdf en pj dur rdv
- Je dois rebalayer, une première fois ma base (400 lignes) pour générer tous les rdv.
- Je dois pouvoir modifier / supprimer les rdv existants si je modifie qqc dans la base.

J'ai ce début de code, mais après je patoge....

qqn aurais une idée ?

Merci

Seb

Code:
Sub GOOGLEAGENDA()
'================================== PARAMETRES GOOGLE AGENDA ==================================
Email = "XXXXX@gmail.com"
passwd = "BLABLA"
authUrl = "https://www.google.com/accounts/ClientLogin"
CALENDARURL = "http://www.google.com/calendar/feeds/default/private/full"
 
 
With Worksheets("BASE EMPLOI")
sujet = Range("b5").Value & " - " & Range("ae5").Value
DESCRIPTIONRDV = Range("AM27").Value
NOMINVITE = "Agenda Emploi"
MAILINVITE = "XXXX@free.fr"
LIEU = "CHEZ MOI"
'DATEDEDEBUT = "2014-01-30T15:00:00.000Z"
'DATEDEFIN = "2014-01-30T17:00:00.000Z"
 
End With
 
'================================== 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='2014-03-31T13:00:00.000Z' " _
& "endTime='2014-03-31T17:00:00.000Z'></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
End Sub
 

Créez un compte ou connectez vous pour répondre

Vous devez être membre afin de pouvoir répondre ici

Créer un compte

Créez un compte Excel Downloads. C'est simple!

Connexion

Vous avez déjà un compte? Connectez vous ici.

Haut Bas