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.
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
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
Example:
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:
gCalenders(2,1)=
gCalenders(2,2)=
And another (Remember to set the intNumberOfgCalendars = 3) :
gCalenders(3,1)=
gCalenders(3,2)=
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
Leave a Reply
Want to join the discussion?Feel free to contribute!