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 ces débuts de code, mais après je patoge....

Je joins mon fichier test:p

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

  • BASE EMPLOI - DEMO.xls
    282 KB · Affichages: 123
  • BASE EMPLOI - DEMO.xls
    282 KB · Affichages: 139
  • BASE EMPLOI - DEMO.xls
    282 KB · Affichages: 158
Dernière édition:

alexandreb06

XLDnaute Nouveau
Merci tatiak, en effet en retournant le net lol pour chercher une solution je suis tomber sur ce post.

Pour mon utilisation j'ai juste besoin, de poser un rdv sur un agenda Gmail avec les infos pré-rempli sur ma feuille. Mais je pense que c'est peine perdue.
 

Statistiques des forums

Discussions
311 733
Messages
2 082 009
Membres
101 865
dernier inscrit
MLL