Optimisation Code / Google Agenda

[GADENSEB]

Re bonjour le Forum,
Je cherche à optimiser mon code !

Plusieurs idées que je déployerais au fur et a mesure :

La 1ére

Cette bdd gére mon google Agenda

Avec l'usf BASEEMPLOI, je rentre les infos dans la BDD
Puis avec l'onglet "BASE EMPLOI" je génére mon googleagenda via la macro GOOGLEAGENDA()

je voudrais que la macro soit incluse dans le code de l'usf BASEEMPLOI commence quand je valide la saisie, le googleagenda est aussi tôt généré.....



Qui à une idée ?

Bonne aprem

Seb




Dans un premier temps les dates doivent être transformées gràce à ce code de l'onglet BASE EMPLOI

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

'Convertit la DATERELANCE en Format de DATE pour GOOGLEAGENDA
j = Range("A1").End(xlDown).Row
For i = 2 To j
  Cells(i, "AP") = "'" & Format(Cells(i, "AL"), "yyyy-mm-dd")
 Cells(i, "A") = Cells(i, "B") & "-" & Cells(i, "C") & "-" & Cells(i, "AF") & "-" & Cells(i, "BB")
Next
End Sub

Puis une macro de sélection des lignes à utiliser

Private Sub GERERAGENDA_Click()

'Private Sub AGENDA()

On Error Resume Next
j = Range("A2").End(xlDown).Row

For i = 2 To j
If Cells(i, 43).Value <> "OK" And Cells(i, 42).Value <> "" Then
GOOGLEAGENDA
Cells(i, 43).Value = "OK"
End If
Next

End Sub

Puis le GoogleAgenda

Sub GOOGLEAGENDA()


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



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

Regarde la pièce jointe 150657

 

[grisan29]

Re : Optimisation Code / En tout genre.....

bonsoir gadenseb

apparemment tu n'as pas plus de succès sur dvp qu'ici

Pascal

 

[GADENSEB]

Re : Optimisation Code / En tout genre.....

Yes .... je cherche toutes les pistes ....

 

[GADENSEB]

Re : Optimisation Code / Google Agenda

Bonsoir,
Je modifie le titre de mon poste pour moi s'il ya plus de motivés

Bonne soirée

Seb