I use Google Calendar a lot (and use multiple calendars) so naturally I want to have access to my calendars on my phone. Of course, if I have a Wi-Fi connection, I can use my Google Calendar with the web browser on the phone; this is a no-brainer. But what if I want to use the Windows Mobile Calendar on the phone itself? One way that might work for most people is with
Google Calendar Sync. Here is another way that requires some tech savvy (and support might not be available in Outlook versions lower than 2007):
- As opposed to Google Calendar Sync, this is one-way synchronization (Google Calendar to MS Outlook to phone) but multiple Google Calendars is supported (Macro below needs to be adjusted slightly)
- ActiveSync syncs with the MS Outlook default calendar (for the Profile the phone has partnership with; more on that in another post)
- You can add the Google Calendar in Outlook (for 2007 version, go File > Data Management > Internet Calendars tab, View and subscribe to Internet Calendars)
- After you've set up the Google Calendar in Outlook (http://www.google.com/support/calendar/bin/answer.py?answer=34576), the trick is to copy the Google Calendar items to the Outlook default calendar as that is what ActiveSync synchronizes to. Use this macro within Outlook
' Author: Alan Leung (in 2008)
'
' MAPI
' |
' +-- Personal Folders
' | |
' | +-- Deleted Items
' | +-- Inbox
' | +-- Calendar
' | +-- ...
' |
' +-- Internet Calendars
' |
' +-- Deleted Items
' +-- Google - Personal
' +-- ...
'
' Interesting articles along the way:
' Import Calendar Days To Specific Cells - Excel Help & VBA Help: http://www.ozgrid.com/forum/showthread.php?t=66377
' How to: Create Appointments: http://msdn.microsoft.com/en-us/library/ms268752(VS.80).aspx
' How Do I ... in Outlook: http://msdn.microsoft.com/en-us/library/bb208173.aspx
' How to programmatically import Outlook items from Access: http://support.microsoft.com/kb/290658
'
' TODO: recurring events do not appear to be copied over
Const CREATED_BY_SYNC_MACRO_TAG As String = "CREATED_BY_SYNC_MACRO"
Sub CopyBetweenCalendars()
Dim eraseDestinationCal As Boolean
eraseDestinationCal = True
Dim originCalName1, originCalName2 As String
originCalName1 = "Name of Calendar 1 in Outlook"
originCalName2 = "Name of Calendar 2 in Outlook"
Dim destinationCal As Outlook.MAPIFolder
Dim ns As Outlook.NameSpace
Set ns = Application.GetNamespace("MAPI")
' This would do the same as the following line
' Set destinationCal = ns.folders.Item("Personal Folders").folders.Item("Calendar")
Set destinationCal = ns.GetDefaultFolder(olFolderCalendar)
' Erase destination calendar
If (eraseDestinationCal) Then
For Each appointment In destinationCal.Items
If appointment.BillingInformation = CREATED_BY_SYNC_MACRO_TAG Then
appointment.Delete
End If
Next appointment
End If
CopyAppointments originCalName1, ns
CopyAppointments originCalName2, ns
MsgBox ("Done executing CopyBetweenCalendars()")
End Sub
Sub CopyAppointments(ByVal originCalName As String, ns As Outlook.NameSpace)
Dim originCal As Outlook.MAPIFolder
Set originCal = ns.Folders.Item("Internet Calendars").Folders.Item(originCalName)
' Set originCal = GetCalendar(originCalName, ns)
' Copy appointments over; TODO: easier, more accurate way to do this?
Dim original As Outlook.AppointmentItem
For Each original In originCal.Items
Dim apptCopy As Outlook.AppointmentItem
Set apptCopy = CreateItem(Outlook.OlItemType.olAppointmentItem)
With apptCopy
.Subject = original.Subject
.Body = original.Body
.Start = original.Start
.End = original.End
.AllDayEvent = original.AllDayEvent
.Location = original.Location
' TODO: recurring appointments?
.ReminderSet = False ' Don't remind, you'll be looking at Calendar
.BillingInformation = CREATED_BY_SYNC_MACRO_TAG
End With
apptCopy.Save
' Something like this doesn't seem to be necessary
' destinationCal.Items.Add apptCopy
Next original
End Sub
- Once you see the "Done executing CopyBetweenCalendars()" message box, let ActiveSync do its thing and voila, you have your Google Calendar items on the phone!
