VBA code, add google calendar entry if a date is added to a database

[dodgemahodge]

Hi folks,

first time poster, wodering can anyone help with the following

i want you to write me an excel vba code that will do the following
-add calendar entries into my google calendar, if a date gets added to the value in Column F
-Event Title will be the Following - BER - {contents of column C} -Event Description will be the following {contents of column A} -- Agreed Fee {contents of column L} -- {contents of column H}
-Event Start time will be the time located in column G
-End time will be start time + 2 hours
-if the date in column F is deleted i want to delete the calendar event
-if the date cell is changed i want to update the calendar entry to reflect the new date and details as noted above.

can anyone help, or point me in the right direction?

Cheers all

 

[nguyendang]

I suggest using Google Calendar API to work with Calendar.
You need to enable Google Calendar API, follow this link for more information.
Then, set up OAuth 2.0 and get information about client id and client secret.
For example, the following VBA macro will add a new event to the calendar of the logged-in user (CalendarId:="primary"):

Private Sub CreateNewEvent()
    Dim objGoogle As GoogleOAuth2
    Set objGoogle = GetSession
    Dim objStartDate As EventDateTime
    Set objStartDate = New EventDateTime
    objStartDate.DateTimeValue = JsonConverter.ConvertToIso(CDate(#4/26/2023 11:00:00 PM#)) 'Start time
    Dim objEndDate As EventDateTime
    Set objEndDate = New EventDateTime
    objEndDate.DateTimeValue = JsonConverter.ConvertToIso(CDate(#4/27/2023 6:00:00 AM#)) 'End time
    Dim objEvent As EventItem
    Set objEvent = New EventItem
    With objEvent
        .Summary = "Create new event" 'Name of event to be created
        Set .StartDateTime = objStartDate 'Start time
        Set .EndDateTime = objEndDate 'End time
    End With
    Debug.Print "Id of the new event is: " & objGoogle.EventsResource.Insert(CalendarId:="primary", EventItem:=objEvent).Id
End Sub

Public Function GetSession() As GoogleOAuth2
    Dim objGoogleOAuth2 As GoogleOAuth2
    Set objGoogleOAuth2 = New GoogleOAuth2
    With objGoogleOAuth2
        .ApplicationName = "GoogleCalendar"
        .ClientID = "Client-Id"
        .ClientSecret = "Client-Secret"
        .Scopes = Array("https://www.googleapis.com/auth/calendar.events")
        .AuthorizeOAuth2
    End With
    Set GetSession = objGoogleOAuth2
End Function

Public Sub LogOut()
    Dim objGoogleOAuth2 As GoogleOAuth2
    Set objGoogleOAuth2 = New GoogleOAuth2
    With objGoogleOAuth2
        .ApplicationName = "GoogleCalendar"
        .ClientID = "Client-Id"
        .LogOut Refresh_Token
    End With
End Sub

As you can see, a new event has been successfully added to the calendar.

Download the sample code: GoogleCalendarAPI.xlam
Note: Office 2019 or later is required to run this macro.

 

[michael140754]

Hi nguyendang,

thanks for posting this code. I went through the Sub CreateNewEvent and it works great, but I`m kind of a beginner and I was not able to work out how to deal with the rest of the Google Calendar API. Any chance you could publish code for how to change/delete events and how to download/upload an array of events?

Kind regards, Michael

 

[nguyendang]

Hi nguyendang,

thanks for posting this code. I went through the Sub CreateNewEvent and it works great, but I`m kind of a beginner and I was not able to work out how to deal with the rest of the Google Calendar API. Any chance you could publish code for how to change/delete events and how to download/upload an array of events?

Kind regards, Michael

Well, the above .xlam add-in is just a wrapper for creating and sending Google Calendar API request, so I suggest that you should read this Google Calendar API overview article to learn more about Google Calendar API.
For example, the following VBA code will list all events in a calendar by CalendarID (CalendarId="primary" means the calendar of the signed-in user):

Public Sub ListEvents()
    Dim objSession As GoogleOAuth2
    Set objSession = GetSession()
    If Not objSession Is Nothing Then
        Dim colEvents As InstancesAndListResponse
        Dim strCalendarId As String
        strCalendarId = "primary"
        On Error Resume Next
        Set colEvents = objSession.EventsResource.List(CalendarId:=strCalendarId)
        If Err.Number <> 0 Then
            MsgBox Err.Description, vbExclamation, "Error"
        End If
        On Error GoTo 0
        If Not colEvents Is Nothing Then
            Dim objEvent As EventItem
            Dim i As Long
            If colEvents.Items.Count > 0 Then
                For i = 1 To colEvents.Items.Count
                    Set objEvent = colEvents.Items.Item(i)
                    Debug.Print objEvent.Id
                    Debug.Print objEvent.Summary
                Next
                If colEvents.NextPageToken <> vbNullString Then Call LoopThroughEventsByPageToken(objSession, colEvents.NextPageToken)
            End If
        End If
    End If
End Sub

Private Sub LoopThroughEventsByPageToken(ByVal Session As GoogleOAuth2, ByVal PageToken As String, Optional ByVal CalendarId As String = "primary")
    If Not Session Is Nothing And PageToken <> vbNullString Then
        Dim colEvents As InstancesAndListResponse
        On Error Resume Next
        Set colEvents = Session.EventsResource.List(CalendarId:=CalendarId, PageToken:=PageToken)
        If Err.Number <> 0 Then
            MsgBox Err.Description, vbExclamation, "Error"
        End If
        On Error GoTo 0
        If Not colEvents Is Nothing Then
            Dim objEvent As EventItem
            Dim i As Long
            If colEvents.Items.Count > 0 Then
                For i = 1 To colEvents.Items.Count
                    Set objEvent = colEvents.Items.Item(i)
                    Debug.Print objEvent.Id
                    Debug.Print objEvent.Summary
                Next
                Dim strPageToken As String
                strPageToken = colEvents.NextPageToken
                While strPageToken <> vbNullString
                    Call LoopThroughEventsByPageToken(Session, strPageToken)
                Wend
            End If
        End If
    End If
End Sub

The following VBA will loop through all calendars subscribed by the signed-in user:

Public Sub ListAllCalendars()
    Dim objSession As GoogleOAuth2
    Set objSession = GetSession()
    If Not objSession Is Nothing Then
        Dim colCalendars As ListCalendarListResponse
        On Error Resume Next
        Set colCalendars = objSession.CalendarListResource.List
        If Err.Number <> 0 Then
            MsgBox Err.Description, vbExclamation, "Error"
        End If
        On Error GoTo 0
        If Not colCalendars Is Nothing Then
            Dim objCalendarList As CalendarList
            Dim i As Long
            If colCalendars.Items.Count > 0 Then
                Set objCalendarList = colCalendars.Items(i)
                Debug.Print objCalendarList.Id
                Debug.Print objCalendarList.Description
            End If
        End If
    End If
End Sub

Hope this will help.