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

GADENSEB · 6 Mai 2014

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

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

Staple1600 · 6 Mai 2014

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

Bonsoir à tous

GADENSEB
Inutile de créer un second fil pour une même question...

Un simple up dans le premier aurait fait l'affaire.
https://www.excel-downloads.com/thr...a-gestion-de-rendez-vous-piece-jointe.219911/
https://www.excel-downloads.com/thr...a-gestion-de-rendez-vous-piece-jointe.219302/

Maintenant si le premier est resté sans réponses, c'est peut-être parce qu'il manque des détails et/ou explications ?

lodam · 27 Mai 2014

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

bonjour GADENSEB
tu as pu avancer de ton côté ?
car j'ai aussi ce projet de synchroniser google agenda et mon fichier excel
merci et bonne soirée
damien

GADENSEB · 27 Mai 2014

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

!Salut

avec ce code, je créer les rdv, mais :
- je ne gére pas la notion de rappel (en temps, sms, mail...)
- et je ne peux modifier un rdv existant.....

Si tu as des pistes je suis preneur.
Bonne soirée.
Seb

Code:

Sub GOOGLEAGENDA()


'================================== PARAMETRES GOOGLE AGENDA ==================================
Email = "XXXXXXX@gmail.com"
Passwd = "XXXXX"
authUrl = "https://www.google.com/accounts/ClientLogin"
CALENDARURL = "http://www.google.com/calendar/feeds/default/private/full"
MAILINVITE = "XXXX@free.fr"
LIEU = "XXXXXXX"



sujet = Range("C" & i).Value & " - " & Range("AF" & i).Value
DESCRIPTIONRDV = Range("AF" & i).Value
NOMINVITE = "Agenda Emploi"

DATEDEBUT = Range("AP" & i).Value & "T13:00:00.000Z"
'DATEDEBUT = Range("F" & i).Value
'& "<gd:when startTime='2014-05-09T13:00:00.000Z' " _
Sheets("Feuil1").Range(int1 & "255" & ":" & int2 & "255").Select
'ConcRange = CStr(rngCell.Value)
DATEFIN = Range("AP" & i).Value & "T17:00:00.000Z"
'DATEFIN = Range("F" & i).Value
'& "endTime='2014-05-09T17:00:00.000Z'></gd:when>" _

 
'================================== 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

End Sub

lodam · 28 Mai 2014

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

bonjour et merci !
j'avais trouvé ce code
L'API Google Calendar et Visual Basic 6.0
mais j'avoue que c'est un peu complexe pour moi et c'est en VB
mais si cela peut t'aider ;-)
j'avance de mon côté et te tiens au courant
merci à toi et bonne journée
damien

GADENSEB · 28 Mai 2014

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

Hello

Enfin QQn qui bosse là dessus !

J'avais trouvé l'API google, mais cela ne me tentais pas trop
Là du coup, il faut développer en XML, pour l'instant je n'ais pas trop le temps...

Par curiosité, ton fichier excel est un "événementiel" ?
Le mien aussi .... j'aimerai comparer avec le tien..

Bonne journée

Sébastien

lodam · 29 Mai 2014

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

mon fichier est un outil de suivi de prospection mais je n'en suis qu'au début
et l'idée par contre de pouvoir me mettre des rendez sur mon téléphone est la raison de ma recherche sur cette idée de synchroniser avec l'api google ;-)
bonne journée

Staple1600 · 29 Mai 2014

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

Bonjour à tous

GADENSEB à dit:
Hello
Enfin QQn qui bosse là dessus !

Pour infos
Il y a longtemps qu'il y a quelqu'un qui travaille la-dessus
Build JSON For Google Calendar API V3 Using VBA - Stack Overflow
(et il est pas tout seul)
mais ceux-là sont anglophones...
Cela tombe bien, VBA parle anglais non ?

EDITION: j'avais oublié ces petits gars aussi
https://developers.google.com/google-apps/calendar/?csw=1#add_event

lodam · 30 Mai 2014

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

merci beaucoup pour ces infos !

lodam · 4 Juin 2014

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

GADENSEB,
avec le code que tu as j'ai une erreur dans le code ;
"erreur d'exécution '5' : argument ou appel de procédure incorrect"
sur la ligne :
"redirectStringLength = InStr(InStr(headers, "X-Redirect-Location:"), headers, vbCrLf) - InStr(headers, "X-Redirect-Location:")

tu as aussi ce souci là ?

merci

GADENSEB · 4 Juin 2014

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

salut

J'avais ce probléme au début,mais il a disparut, il me semble en désactivant :

Code:

If objHTTP.Status = 201 Then
   MsgBox "Event saved"
   Else
   MsgBox "marche pas"
End If

Seb

GADENSEB · 5 Juin 2014

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

Hello
j'ai regardé ton Code, j'avoue ne pas tout comprendre !!

Quel est le concept de ton événementiel ?

lodam · 5 Juin 2014

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

ben non malheureusement ça ne fonctionne toujours pas et à priori ça vient d'une erreur 404

le reste du code est un essai avec JSON mais qui s'avère être encore plus complexe....https://www.excel-downloads.com/threads/excel-json-et-google-agenda.220730/

je patauge en fait

je crois que je vais passer par un export en CSV depuis excel et un import manuel de google....grrrr

Staple1600 · 5 Juin 2014

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

Bonsoir à tous

je patauge en fait

Voici peut-être une bouée... ou de quoi patauger encore un peu plus
(En tout cas c'est pour le moins intéressant et toujours agréable à lire avant d'aller se coucher

lodam · 6 Juin 2014

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

merci beaucoup ! c'est très sympa de m'envoyer cette bouée !
je crois que je vais arrêter de boire la tasse pendant quelques heures en tous les cas !
;-)

Effectuez une recherche sur Excel Downloads...

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

GADENSEB

XLDnaute Impliqué

Pièces jointes

Staple1600

XLDnaute Barbatruc

lodam

XLDnaute Occasionnel

GADENSEB

XLDnaute Impliqué

Pièces jointes

lodam

XLDnaute Occasionnel

GADENSEB

XLDnaute Impliqué

lodam

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

lodam

XLDnaute Occasionnel

lodam

XLDnaute Occasionnel

Pièces jointes

GADENSEB

XLDnaute Impliqué

GADENSEB

XLDnaute Impliqué

lodam

XLDnaute Occasionnel

Staple1600

XLDnaute Barbatruc

lodam

XLDnaute Occasionnel

Discussions similaires

Membres actuellement en ligne

Partager cette page

Tutos vidéos

Statistiques des forums