Recently our sysadmin at work took another step at locking our calendar.
So naturally I had to find a way around their block.
If you are using Outlook app on the computer this could work for you.
If you are lucky then you can just copy paste and it will work fine, but if it does not work then you might need to know some VBA debugging.
This method makes a copy of your work calendar to another calendar that you create that is then shared with HA.
I recommend you create a new account on outlook.com to get a personal email and calendar account.
Using a pre-existing could work but if you have created different calendars inside the account then it will be more complex for the code to find the right spot to create new appointments at.
You need to enable VBA/macros for Outlook, follow this guide if you don’t know how to do it.
I have mine set to notify for all macros, and that is enough for this application.
Open the VBA explorer by pressing ALT+F11.
If you never done anything here before then it’s probably empty.
We need to add some code both in the ThisoutlookSession module but we also need to add a separate module.
Press the button to add a module:
(In my image I already have two modules, JsonConverter and Modul1).
Lets start with opening the ThisOutlookSession. double click on it.
This is the events listener.
Here we tell Outlook to do something when something happens.
This is the code we need, you can delete some of these events if you don’t want the code to run as often.
But the first event is when you send an email, the second one is when you get a reminder that you have a meeting in xx minutes, and the last one is when you open Outlook.
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Modul1.copy_calender
End Sub
Private Sub Application_Reminder(ByVal Item As Object)
Modul1.copy_calender
End Sub
Private Sub Application_Startup()
Modul1.copy_calender
End Sub
At each of these times I make Outlook update my HA-work calendar. And here you can modify this as you like.
One thing that is very important is to check the spelling of Modul1.
Depending on the language of your install this will be different.
So the previous step was to create a module, in my case (and as you can see from the image) mine was called Modul1.
Make sure the spelling is correct.
Now we open the module we created.
Sub copy_calender()
Dim olApp As Outlook.Application
Dim olappt As Outlook.AppointmentItem
Dim bAppOpened As Boolean
Dim myNamespace As Outlook.NameSpace
Dim myFolder As Outlook.Folder
Dim objPane As Outlook.NavigationPane
Dim objModule As Outlook.CalendarModule
Dim CalFolder As Outlook.Folder
On Error Resume Next
Set olApp = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Err.Clear
Set olApp = CreateObject("Outlook.Application")
bAppOpened = False ' Outlook was not already running, started it
Else
bAppOpened = True ' Outlook was already running
End If
On Error GoTo 0
Set objPane = Outlook.Application.ActiveExplorer.NavigationPane
Set objModule = objPane.Modules.GetNavigationModule(olModuleCalendar)
' Below the code will loop through all calendars you have added to your Outlook app.
' When it finds the correct calendar it skips out of the loop.
With objModule.NavigationGroups
On Error Resume Next
For g = 1 To .Count
If Not CalFolder Is Nothing Then Exit For
Set objGroup = .Item(g)
For i = 1 To objGroup.NavigationFolders.Count
Set objNavFolder = objGroup.NavigationFolders.Item(i)
' edit this line with the name of the email and what the name of the calendar is
If objNavFolder.Folder.FolderPath = "\\[email protected]\Kalender" Then
Set CalFolder = objNavFolder.Folder
'MsgBox CalFolder
Exit For
End If
Next
Next
End With
' Your HA-calendar should be fond when the code gets here.
' Now we need to get your main calendar and grab the next 14 days of appointments.
Dim cAppt As AppointmentItem
Dim objAppointment As AppointmentItem
Dim NS As Outlook.NameSpace
Set NS = Application.GetNamespace("MAPI")
Set myNamespace = Application.GetNamespace("MAPI")
tdystart = VBA.Format(Now, "Short Date")
tdyend = VBA.Format(Now + 14, "Short Date")
Set myAppointments = myNamespace.GetDefaultFolder(olFolderCalendar).Items
myAppointments.Sort "[Start]"
myAppointments.IncludeRecurrences = True
Set currentAppointment = myAppointments.Find("[Start] >= """ & tdystart & """ and [Start] <= """ & tdyend & """")
While TypeName(currentAppointment) <> "Nothing"
' here it loops your work calendar, then the for each loop below loops your HA-calendar.
' if fnd remains false that means there is a new meeting that is not in your HA-calendar
fnd = False
For Each apt In CalFolder.Items
If apt.Start = currentAppointment.Start And apt.Subject = currentAppointment.Subject And apt.End = currentAppointment.End Then
fnd = True
Exit For
ElseIf Now() - apt.Start > 30 Then
' here I remove calendar entries in your HA-work calendar that is older than 30 days, meaning last months appointments. Shorten this if you are a busy person.
apt.Delete
End If
Next apt
If fnd = False Then
' add the new appointment to your HA-calendar.
Set olappt = CalFolder.Items.Add
With olappt
.Subject = currentAppointment.Subject
.Start = currentAppointment.Start
.Duration = currentAppointment.Duration
.Location = currentAppointment.Location
.Body = currentAppointment.Body
.Save
End With
End If
Set currentAppointment = myAppointments.FindNext
Wend
End Sub
There is one line that needs to be edited, and that is the account and calendar name.
Here is what it looks like for me:
The green line is my HA-work calendar, the code block above has one line with: If objNavFolder.Folder.FolderPath = "\\[email protected]\Kalender" Then
This is your HA-work calendar.
The code will only look at 14 days at the time.
The code will delete events in your HA-calendar that is older than 30 days. So today, 2024-05-20 it deletes events that is older than 2024-04-20 (or whatever it becomes).
This is to make sure the looping of the HA-calendar does not take too much time.
I could probably do the same kind of loop as the other main calendar does, but for me it makes no difference.
Feel free to change it if you like.
So if everything works, the code should run rather quickly, you can press F5 to run it.
And you should be able to see all events mirrored in your new calendar, that you then can integrate in HA with no issues.
Don’t forget to press the save button in VBA explorer before you close Outlook.
I have done that mistake many many times…