This is a Visual Basic script that backs up your online Google calendars. All you need to do is copy the code into a text editor such as notepad or my favourite Ultra Edit then save the file as Calendar-BackUp.vbs (not .txt or this is really not going to work for you).
Save your newly created file into a folder. This is where your backups are going to be saved.
Then we need to edit the following bits of code to get this running:
1) How many days do you want to keep, because this takes a new full calendar copy each time then you will soon have quite a few files, this setting deletes older backups for you:
Const intDaysOld = 200
2) How many online calenders do you have and want to backup.
Const intNumberOfgCalendars = 3
3) The last bit of editing is to get the calendar information.
Go to your Google Calendar www.google.com/calendar and find the settings.
Near the bottom of the setting page you will see ‘Private Address:’ and next to that the ‘ICAL’ button.
Click the ical button which will present you with a long URL which you need to copy and paste over: gCalenders(1,1)=”http://www.google.com/calendar/ical/SOME-CODES-1/basic.ics”
Then name the calendar by replacing: gCalenders(1,2)=”Coding Stuff”
A bit more about these elements and their formatting:
gCalenders(1 FIRST NUMBER GROUPS THE GOOGLE CALENDER URL AND SAVED FILE NAME TOGETHER
gCalenders(1,1 SECOND NUMBER INDICATES THAT THIS IS THE URL AND IS ALWAYS 1
gCalenders(1,2 SECOND NUMBER INDICATES THAT THIS IS SAVED FILE NAME AND IS ALWAYS 2
gCalenders(1,1)=”http://www.google.com/calendar/ical/blah/blah/basic.ics” THIS IS THE PRIVATE ICAL ADDRESS FOR A CALENDER
gCalenders(1,2)=”My Calender” THIS IS THE FILE NAME THAT THE CALENDER WILL BE SAVED AS
If you want to add another calender then simply add one number to the group (Remember to set the intNumberOfgCalendars = 2) ie:
And another (Remember to set the intNumberOfgCalendars = 3) :
Get the code:
'Google Calendar BackUp by Dean Andrews 'Source: https://deanandrews.uk/google-calendar-backup/ 'Version 1.0 - 28-01-2010 'Version 1.1 - 05-05-2011 - Added support for dropbox 'How many days of backups do you want to keep Const intDaysOld = 200 'By default the backups are saved in the same directory as this script however you can set your save path ie "C:\Google Calendar Backup" this folder does not need to exists as it will be created for you strSavePath = left(WScript.ScriptFullName,(Len(WScript.ScriptFullName))-(len(WScript.ScriptName))) 'How many Calendars do you have listed below !!!important!!! Const intNumberOfgCalendars = 3 'Don't touch this ReDim gCalenders(intNumberOfgCalendars,2) 'Now set your calendars gCalenders(1,1)="http://www.google.com/calendar/ical/SOME-CODES-1/basic.ics" gCalenders(1,2)="Coding Stuff" gCalenders(2,1)="http://www.google.com/calendar/ical/SOME-CODES-2/basic.ics" gCalenders(2,2)="UK Holidays" gCalenders(3,1)="http://www.google.com/calendar/ical/SOME-CODES-3/basic.ics" gCalenders(3,2)="Family" 'That's it you don't need to change anythig else strDate = FormatDateTime(Date(),vbLongDate) Set objFso = CreateObject("Scripting.FileSystemObject") strDirectory = strSavePath 'Check if the strSavePath exists if not the make it If objFso.FolderExists(strSavePath) = False Then Call objFso.CreateFolder(strSavePath) End If 'Add to the strSavePath the next folder level strSavePath = strSavePath & "\" & strDate 'Check if the strSavePath exists if not the make it If objFso.FolderExists(strSavePath) = False Then Call objFso.CreateFolder(strSavePath) End If For i = 1 To intNumberOfgCalendars 'Add to the file name to the strSavePath strFilePath = strSavePath & "\" & gCalenders(i,2) & ".ics" 'Fetch the calendars data and save it Call getICS (gCalenders(i,1),strFilePath) 'Once we have done all the calendars then finish 'if i = intNumberOfgCalendars then msgbox "Google Calenders Backup Done" Next ' Fetch the file Sub getICS (strFileURL,strSaveAs) 'Create an instance of MSXML2.XMLHTTP (COM object that provides a way for client computers to interact with HTTP servers). Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP") 'Open method 'GET = retrieve information from the server 'strFileURL the variable holding the URL 'False makes the call synchronous objXMLHTTP.open "GET",strFileURL, False 'Send method to send our request to the server. objXMLHTTP.send() 'Check if the URL is correct If objXMLHTTP.Status = 200 Then Set objADOStream = CreateObject("ADODB.Stream") objADOStream.Open objADOStream.Type = 1 'adTypeBinary objADOStream.Write objXMLHTTP.ResponseBody objADOStream.Position = 0 'Set the stream position to the start If objFso.Fileexists(strSaveAs) Then objFso.DeleteFile strSaveAs objADOStream.SaveToFile strSaveAs objADOStream.Close Set objADOStream = Nothing End If Set objXMLHTTP = Nothing End Sub 'Delete Old Data Dim objFolder : Set objFolder = objFSO.GetFolder(strDirectory) Dim objSubFolder For Each objSubFolder In objFolder.SubFolders If objSubFolder.DateLastModified < DateValue(Now() - intDaysOld) Then 'WScript.Echo objSubFolder.DateLastModified objSubFolder.Delete True End If Next