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 ces débuts de code, mais après je patoge....
Je joins mon fichier test
qqn aurais une idée ?
Merci
Seb
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 ces débuts de code, mais après je patoge....
Je joins mon fichier test
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
Code:
Private Sub GOOGLEAGENDAGUI()
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.Open "POST", "https://www.google.com/accounts/ClientLogin", False
xmlhttp.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
xmlhttp.send "accountType=HOSTED_OR_GOOGLE&Email=adress@gmail.com&Passwd=motdepasse" & "&source=Gulp-CalGulp-1.05&service=cl"
Lines = Split(xmlhttp.responseText, vbLf)
nvp = Split(Lines(2), "=")
Set xmlhttp = Nothing
heurealert = DateAdd("n", 2, Now)
heuredebut = DateAdd("n", 10, heurealert)
heurefin = DateAdd("n", 30, heuredebut)
starttime = Year(heuredebut) & "-" & String(2 - Len(Month(heuredebut)), "0") & Month(heuredebut) & "-" & String(2 - Len(Day(heuredebut)), "0") & Day(heuredebut) & "T" & String(2 - Len(Hour(heuredebut)), "0") & Hour(heuredebut) & ":" & String(2 - Len(Minute(heuredebut)), "0") & Minute(heuredebut) & ":" & String(2 - Len(Second(heuredebut)), "0") & Second(heuredebut)
alerttime = Year(heurealert) & "-" & String(2 - Len(Month(heurealert)), "0") & Month(heurealert) & "-" & String(2 - Len(Day(heurealert)), "0") & Day(heurealert) & "T" & String(2 - Len(Hour(heurealert)), "0") & Hour(heurealert) & ":" & String(2 - Len(Minute(heurealert)), "0") & Minute(heurealert) & ":" & String(2 - Len(Second(heurealert)), "0") & Second(heurealert)
endtime = Year(heurefin) & "-" & String(2 - Len(Month(heurefin)), "0") & Month(heurefin) & "-" & String(2 - Len(Day(heurefin)), "0") & Day(heurefin) & "T" & String(2 - Len(Hour(heurefin)), "0") & Hour(heurefin) & ":" & String(2 - Len(Minute(heurefin)), "0") & Minute(heurefin) & ":" & String(2 - Len(Second(heurefin)), "0") & Second(heurefin)
sujet = "test envoi auto"
contenu = "serveur dans les choux"
LIEU = "ben dans la salle serveur..."
calentry = "<?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'/>" & "<title type='text'>" & sujet & "</title>" & "<content type='text'>" & contenu & "</content>" & "<gd:transparency value='http://schemas.google.com/g/2005#event.opaque'/>" & "<gd:eventStatus value='http://schemas.google.com/g/2005#event.confirmed'/>" & "<gd:where valueString='" & LIEU & "'/>" & "<gd:when startTime='" & starttime & ".000+02:00' endTime='" & endtime & ".000+02:00'>" & "<gd:reminder absoluteTime='" & alerttime & "+01:45' method='alert'/>" & "</gd:when></entry>"
url = "http://www.google.com/calendar/feeds/default/private/full"
postEntry (url)
End Sub
Function postEntry(url)
Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
xmlhttp.Open "POST", url, False
xmlhttp.setRequestHeader "Content-type", "application/atom+xml"
xmlhttp.setRequestHeader "X-If-No-Redirect", "True"
xmlhttp.setRequestHeader "Authorization", "GoogleLogin auth=" & nvp
xmlhttp.send calentry
testUrl = InStr(url, "?gsessionid")
If testUrl = 0 Then
redirect = xmlhttp.getResponseHeader("X-Redirect-Location")
postEntry (redirect)
End If
Set xmlhttp = Nothing
End Function
Pièces jointes
Dernière édition: