Hello,
I am working in Access and trying to do the following:
Login to google calendar – This works fine.
Find an entry based on a title and date start (I was trying start-min/
start-max – but does not work need help here)
If record found – Delete (not sure how to do this part
either)
Add event (got this working).
I am new to this xml, so I hope you can help guide me through the find
and delete.
Attached is my code so far, which has hard coded entries, since I am
testing.
Thanks,
Dan
Option Compare Database
Option Explicit
Dim AuthCode As String
Dim Responded As Boolean
Dim Response As String
Dim EventCode As String
Dim tzoffset As String
Private Sub btnExit_Click()
Unload Me
End Sub
Private Sub Command10_Click()
Dim strURL As String, strFormData As String, strHeaders As String
Dim myEmail As String, myPassword As String, mySource As String
myEmail = "[EMAIL PROTECTED]"
myPassword = "abc"
mySource = "TEST"
'***************************************
'****************This portion works fine
'***************************************
'First we need to authenticate the user as a Google account holder.
strURL = "https://www.google.com/accounts/ClientLogin";
strFormData = "accountType=HOSTED_OR_GOOGLE&Email=" & myEmail &
"&Passwd=" & myPassword & "&source=" & mySource & "&service=cl"
strHeaders = "Content-Type:application/x-www-form-urlencoded"
Inet1.Execute strURL, "POST", strFormData, strHeaders
'wait for server response - should include the auth token
Responded = False
Do Until Responded = True
DoEvents
Loop
'ensure password was correct according to Google
If InStr(Response, "BadAuthentication") Then 'password didn't work
MsgBox "Google refused authorization. Please check your email
address and password and try again.", vbCritical, "Error"
Exit Sub 'quit
End If
'extract Google authorization token
AuthCode = Right(Response, Len(Response) - InStrRev(Response, "Auth=")
- 4)
EventCode = getEventCode 'prepare the event code
'********************************************
'*******************This is where i am lost
'********************************************
'Find event - I really want to find based on date and title
strURL = "http://www.google.com/calendar/feeds/default/private/full?
start-min=2008-09-28T18:00:00&start-max=2008-09-28T22:00:00"
strFormData = EventCode
strHeaders = "Authorization: GoogleLogin auth=" & AuthCode & _
"Content-Type:application/atom+xml"
Responded = False
Inet1.Execute strURL, "GET", strFormData, strHeaders
'wait for server response - should confirm event
Do Until Responded = True
DoEvents
Loop
If (InStr(Inet1.GetHeader, "201 Created") > 0) Then
Me.Text0 = Inet1.GetHeader
MsgBox "Event Found", , "Sucess" & vbCrLf & Inet1.GetHeader,
vbCritical, "Failed"
'Issue a Delete
'now post the event in order for Google to give us a session id.
strURL = "http://www.google.com/calendar/feeds/default/private/
full"
strFormData = getEventCodeD
strHeaders = "Authorization: GoogleLogin auth=" & AuthCode & _
"Content-Type:application/atom+xml"
Responded = False
' Me.Text0 = AuthCode
Inet1.Execute strURL, "PUT", strFormData, strHeaders
'wait for server response - should confirm event
Do Until Responded = True
DoEvents
Loop
If (InStr(Inet1.GetHeader, "201 Created") > 0) Then
MsgBox "Event Deleted", , "Success"
Else
MsgBox "Event not added. Please check your input and try
again." & vbCrLf & Inet1.GetHeader, vbCritical, "Failed"
End If
Else
MsgBox "Event not Not Found." & Inet1.GetHeader
End If
'********************************************
'********************************************
'********************************************
'********************************************
'*******************This part works fine
'********************************************
'now post the event in order for Google to give us a session id.
strURL = "http://www.google.com/calendar/feeds/default/private/full";
strFormData = EventCode
strHeaders = "Authorization: GoogleLogin auth=" & AuthCode & _
"Content-Type:application/atom+xml"
Responded = False
Me.Text0 = AuthCode
Inet1.Execute strURL, "POST", strFormData, strHeaders
'wait for server response - should confirm event
Do Until Responded = True
DoEvents
Loop
If (InStr(Inet1.GetHeader, "201 Created") > 0) Then
MsgBox "Event added" & Inet1.GetHeader, , "Success"
Else
MsgBox "Event not added. Please check your input and try again." &
vbCrLf & Inet1.GetHeader, vbCritical, "Failed"
End If
'go and check your Google calendar - your event should be there!
End Sub
Private Sub Inet1_StateChanged(ByVal STATE As Integer)
Dim vtData As Variant ' Data variable.
Dim outputString As String
Select Case STATE
' ... Other cases not shown.
Case icError ' 11
MsgBox "An error occured. Check both your and the server's
internet connection is working.", vbCritical, "Error"
Case icResponseCompleted ' 12
' Open a file to write to.
' Get the first chunk. NOTE: specify a Byte
' array (icByteArray) to retrieve a binary file.
vtData = Inet1.GetChunk(1024, icString)
Do While LenB(vtData) > 0
outputString = outputString + vtData
' Get next chunk.
vtData = Inet1.GetChunk(1024, icString)
Loop
Response = outputString
Responded = True
End Select
End Sub
Private Function getEventCode() As String
Dim formattedDate As String
'change the date into Google's yyyy-mm-dd format
formattedDate = Format(Date, "yyyy-mm-dd")
getEventCode = "<entry xmlns='http://www.w3.org/2005/Atom'" & vbCrLf &
_
"xmlns:gd='http://schemas.google.com/g/2005'>" & vbCrLf & _
" <category scheme='http://schemas.google.com/g/2005#kind'" & vbCrLf
& _
"term='http://schemas.google.com/g/2005#event'></category>" & vbCrLf
& _
" <title type='text'>" & "Meet with President" & "</title>" & vbCrLf
& _
"<content type='text'>" & "XXX" & "</content>" & vbCrLf & _
"<author>" & vbCrLf & _
"<name>" & "DAN" & "</name>" & vbCrLf & _
"<email>" & "[EMAIL PROTECTED]" & "</email>" & vbCrLf & _
"</author>" & vbCrLf & _
"<gd:transparency" & vbCrLf & _
"value='http://schemas.google.com/g/2005#event.opaque'>" & vbCrLf
& _
"</gd:transparency>" & vbCrLf & _
"<gd:eventStatus" & vbCrLf & _
"value='http://schemas.google.com/g/2005#event.confirmed'>" &
vbCrLf & _
"</gd:eventStatus>" & vbCrLf & _
"<gd:where valueString='" & "My House" & "'></gd:where>" & vbCrLf &
_
"<gd:when startTime='" & formattedDate & "T19:00:00.000Z'" & vbCrLf
& _
"endTime='" & formattedDate & "T21:00:00.000Z'></gd:when>" &
vbCrLf & _
"</entry>"
End Function
Private Function getEventCodeD() As String
Dim formattedDate As String
'change the date into Google's yyyy-mm-dd format
formattedDate = Format(Date, "yyyy-mm-dd")
getEventCodeD = "<entry xmlns='http://www.w3.org/2005/Atom'" & vbCrLf
& _
"xmlns:gd='http://schemas.google.com/g/2005'>" & vbCrLf & _
"<id>http://www.google.com/calendar/feeds/default/private/full/
d8qbg9egk1n6lhsgq1sjbqffqc</id>" & _
"<category scheme='http://schemas.google.com/g/2005#kind'
term='http://schemas.google.com/g/2005#event' />" & _
"<title type='text'>Event deleted via batch</title>" & _
"<link rel='alternate' type='text/html'" & _
"href='http://www.google.com/calendar/event?
eid=ZDhxYmc5ZWdrMW42bGhzZ3Exc2picWZmcWMgaGFyaXNodi50ZXN0QG0'
title='alternate' />" & _
"<link rel='self' type='application/atom+xml'" & _
"href='http://www.google.com/calendar/feeds/default/private/
full/d8qbg9egk1n6lhsgq1sjbqffqc' />" & _
"<link rel='edit' type='application/atom+xml'" & _
"href='http://www.google.com/calendar/feeds/default/private/
full/d8qbg9egk1n6lhsgq1sjbqffqc/63326018324' />" & _
"</entry>"
End Function
--~--~---------~--~----~------------~-------~--~----~
You received this message because you are subscribed to the Google Groups
"Google Calendar Data API" group.
To post to this group, send email to
[email protected]
To unsubscribe from this group, send email to [EMAIL PROTECTED]
For more options, visit this group at
http://groups.google.com/group/google-calendar-help-dataapi?hl=en
-~----------~----~----~----~------~----~------~--~---
