Outlook Calendar As Trigger for Rule (VBA Script)

Community Projects
1

There have been a few questions here about how to trigger rules at a certain time through the use of some sort of calendar tile. I came up with another solution, which may be of some use to someone. I started using Microsoft Outlook to trigger Hubitat directly. You can also use it to trigger a Sharptools rule as discussed at How to trigger SharpTools rules using HTTP - SharpTools Knowledge Base

To use, enter an appointment in Outlook named Wakeup. I have a recurring appointment 5 days a week at 6:40AM. When Wakeup fires, it sends HTTP Posts to Hubitat to turn on the lights. The code resides on my office PC. But, I also have Outlook installed on my Iphone. So, I can enter, adjust or delete the wakeups from my phone.

Iā€™m sure that a real programmer can write some more efficient code. But, my Outlook code is as follows:
While in Outlook, press Alt-F11 to enter the VBA environment.
Insert a Module. Then enter the following code:

Option Explicit
Sub SubWakeup()
Dim ThisDeviceID As String
Dim sTheHTTP As String

'Turn on Mike's bedside lamp
ThisDeviceID = "34"
sTheHTTP = "http://192.168.xxx.55/apps/api/48/devices/" & ThisDeviceID & "/on?access_token=USE ACTUAL TOKEN"
SendPost (sTheHTTP)

'Turn on Mike's overhead light
ThisDeviceID = "35"
sTheHTTP = "http://192.168.xxx.55/apps/api/48/devices/" & ThisDeviceID & "/on?access_token=USE ACTUAL TOKEN"
SendPost (sTheHTTP)

'Additional code turns on several more lights

End Sub

Sub SendPost(sSendPostHTTP As String)
Dim LoginRequest As Object
Set LoginRequest = CreateObject("WinHttp.WinHttpRequest.5.1")
LoginRequest.Open "POST", sSendPostHTTP, False
LoginRequest.setRequestHeader "Content-type", "application/x-www-form-urlencoded"
LoginRequest.Send
'MsgBox sSendPostHTTP, vbDefaultButton1, "it fired" 'For Testing
End Sub

Then, go to ThisOutlookSession and enter the following:

Option Explicit
Private WithEvents MyReminders As Outlook.Reminders

Private Sub Application_Startup()
    On Error Resume Next
    Set MyReminders = Outlook.Application.Reminders
End Sub

Private Sub MyReminders_ReminderFire(ByVal ReminderObject As Reminder)
    Dim TheReminderCaption As String
    Dim TheReminderDate As Date
    TheReminderCaption = Trim(LCase(ReminderObject.Caption)) 'Iphone will append a spacebar.  So, clean it out.
    On Error Resume Next
    
    If TheReminderCaption = "wakeup" Or TheReminderCaption = "wake-up" Then 
            Beep
        TheReminderDate = ReminderObject.OriginalReminderDate
        If DateDiff("n", Now, TheReminderDate) > 5 Then 'The PC was off when the appointment was scheduled and we don't want to turn on the lights when Outlook is opened later.
            MsgBox "Date = " & Date & vbCr & "TheReminderDate = " & TheReminderDate, vbCritical, "DateDiff Too High"
            Exit Sub
        End If
        Call SubWakeup
        ReminderObject.Dismiss
    End If
End Sub
1 Like
2

Thanks for sharing! Great example!