Created
July 9, 2020 19:10
-
-
Save konijn/04caa0083ac0509f0cb6c6012b31b24c to your computer and use it in GitHub Desktop.
Play sounds when the event starts in Outlook
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Option Explicit | |
Const SOUND_FILE_LOCATION As String = "C:\Users\Demuyt\Documents\REMINDER.WAV" | |
Const ACTION_CUTOFF_IN_SECONDS As Integer = 1600 | |
Sub setMeetingReminderSounds() | |
Dim reminder As reminder | |
Dim appointment As AppointmentItem | |
Dim secondsLeft As Long | |
Dim status As String | |
For Each reminder In Application.reminders | |
Set appointment = reminder.Item | |
secondsLeft = DateDiff("s", Now, appointment.start) | |
If secondsLeft > 0 And secondsLeft < ACTION_CUTOFF_IN_SECONDS Then | |
If Not appointment.ReminderOverrideDefault Then | |
appointment.ReminderOverrideDefault = True | |
appointment.ReminderPlaySound = True | |
appointment.ReminderSet = True | |
appointment.ReminderSoundFile = SOUND_FILE_LOCATION | |
appointment.Save | |
status = "Updated" | |
Else | |
status = "Upcoming" | |
End If | |
'Give some feedback on what's coming up | |
Debug.Print status & "; " & reminder.Caption, appointment.start, secondsLeft & " seconds left" | |
End If | |
DoEvents 'Good manners | |
Next | |
End Sub |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment