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:

Staple1600

XLDnaute Barbatruc
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...:rolleyes:
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

XLDnaute Occasionnel
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

XLDnaute Impliqué
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
 

Pièces jointes

  • BASE EMPLOI - DEMO DEMO.xlsm
    148.7 KB · Affichages: 111
  • BASE EMPLOI - DEMO DEMO.xlsm
    148.7 KB · Affichages: 111
  • BASE EMPLOI - DEMO DEMO.xlsm
    148.7 KB · Affichages: 130
Dernière édition:

GADENSEB

XLDnaute Impliqué
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

XLDnaute Occasionnel
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

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

Bonjour à tous

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
 
Dernière édition:

lodam

XLDnaute Occasionnel
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
 

Pièces jointes

  • googlecal2.xlsm
    124.5 KB · Affichages: 145
Dernière édition:

GADENSEB

XLDnaute Impliqué
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
 

lodam

XLDnaute Occasionnel
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
 

lodam

XLDnaute Occasionnel
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 !
;-)
 

Statistiques des forums

Discussions
311 724
Messages
2 081 936
Membres
101 844
dernier inscrit
pktla