How to make an outlook reminder popup and stay on top of other windows

For the latest macro please see update 4 (Office 365 inclusion)

After searching for a while I found a partial answer on a website that seemed to give me the majority of the solution;https://superuser.com/questions/251963/how-to-make-outlook-calendar-reminders-stay-on-top-in-windows-7

However as noted in the comments, the first reminder failed to popup; while further reminders then did. based on the code I assumed this was because the window wasn't detected until it had instantiated once

To get around this, I looked to employ a timer to periodically test if the window was present and if it was, then bring it to the front.Taking the code from the following website; Outlook VBA - Run a code every half an hour

Then melding the two solutions together gave a working solution to this problem.

From the trust centre, I enabled the use of macros then opening the visual basic editor from Outlook (alt+F11) I added the following code to the 'ThisOutlookSession' module

CODE REMOVED

UPDATE 1 (Feb 12, 2015)

After using this for a while I found a real annoyance with the fact that triggering the timer removes the focus from the current window. It's a massive hassle as you're writing an e-mail.

As such I upgraded the code so that the timer only runs every 60 seconds then upon finding the first active reminder, the timer is stopped and the secondary event function is then used forthwith to activate the window focus change.

UPDATE 2 (Sep 4, 2015)

Having transitioned to Outlook 2013 - this code stopped working for me. I have now updated it with a further function (FindReminderWindow) that looks for a range of popup reminder captions. This now works for me in 2013 and should work for versions below 2013.

The FindReminderWindow function takes a value which is the number of iterations to step through to find the window. If you routinely have a larger number of reminders than 10 popup then you could increase this number in the EventMacro sub...

CODE REMOVED

UPDATE 3 (Aug 8, 2016)

Having rethought my approach and based on observation - I redesigned the code to try and have a minimal impact on working while Outlook was open; I would find the timer still took focus away from e-mails I was writing and possibly other issues with windows losing focus might have been related.

Instead - I assumed the reminders window once instantiated was merely hidden and not destroyed when reminders were shown; as such I now keep a global handle to the window so I should only need to look once at the window titles and subsequently check if the reminders window is visible before making it modal.

Also - the timer is now only employed when the reminders window is triggered, then turned off once the function has run; hopefully stopping any intrusive macro's running during the working day.

See which one works for you I guess...

Updated code below:Add the following code to the 'ThisOutlookSession' module

Private WithEvents MyReminders As Outlook.RemindersPrivate Sub Application_Startup()    On Error Resume Next    Set MyReminders = Outlook.Application.RemindersEnd SubPrivate Sub MyReminders_ReminderFire(ByVal ReminderObject As Reminder)    On Error Resume Next    Call ActivateTimer(1)End Sub

Then the updated module code...

Option ExplicitPrivate Declare Function SetTimer Lib "User32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _    ByVal uElapse As Long, ByVal lpTimerfunc As Long) As LongPrivate Declare Function KillTimer Lib "User32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As LongPrivate Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As LongPrivate Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName _    As String, ByVal lpWindowName As String) As LongPrivate Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal nCmdSHow As Long) As LongPrivate Declare Function SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _    ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As LongPrivate Const SWP_NOSIZE = &H1Private Const SWP_NOMOVE = &H2Private Const FLAGS As Long = SWP_NOMOVE Or SWP_NOSIZEPrivate Const HWND_TOPMOST = -1Public TimerID As Long 'Need a timer ID to turn off the timer. If the timer ID <> 0 then the timer is runningPublic hRemWnd As Long 'Store the handle of the reminder windowPublic Sub ActivateTimer(ByVal Seconds As Long) 'The SetTimer call accepts milliseconds    On Error Resume Next    If TimerID <> 0 Then Call DeactivateTimer   'Check to see if timer is running before call to SetTimer    If TimerID = 0 Then TimerID = SetTimer(0, 0, Seconds * 1000, AddressOf TriggerEvent)End SubPublic Sub DeactivateTimer()    On Error Resume Next    Dim Success As Long: Success = KillTimer(0, TimerID)    If Success <> 0 Then TimerID = 0End SubPublic Sub TriggerEvent(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)    Call EventFunctionEnd SubPublic Function EventFunction()    On Error Resume Next    If TimerID <> 0 Then Call DeactivateTimer    If hRemWnd = 0 Then hRemWnd = FindReminderWindow(100)    If IsWindowVisible(hRemWnd) Then        ShowWindow hRemWnd, 1                                   ' Activate Window        SetWindowPos hRemWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS   ' Set Modal    End IfEnd FunctionPublic Function FindReminderWindow(iUB As Integer) As Long    On Error Resume Next    Dim i As Integer: i = 1    FindReminderWindow = FindWindow(vbNullString, "1 Reminder")    Do While i < iUB And FindReminderWindow = 0        FindReminderWindow = FindWindow(vbNullString, i & " Reminder(s)")        i = i + 1    Loop    If FindReminderWindow <> 0 Then ShowWindow FindReminderWindow, 1End Function

UPDATE 4 (Sep 9, 2021)

Transition to Office 365: This comes with an option in the settings now to show reminders on top of windows (picture below), so why would you want to run a macro to place it on top now? The reason is that you can set it as a modal reminder box (using SWP_DRAWFRAME) so if you swap between programs, it will stay visible which doesn't happen with the vanilla option

Code should be compatible with all Outlook versions and allow transition between them easily (however I can no longer error check the non-VBA7 code)

In ThisOutlookSession

Private WithEvents MyReminders As Outlook.RemindersPrivate Sub Application_Startup()    On Error Resume Next    With Outlook.Application        Set MyReminders = .Reminders    End WithEnd SubPrivate Sub MyReminders_ReminderFire(ByVal ReminderObject As Reminder)    On Error Resume Next    Call ReminderStartTimerEnd Sub

In a module

Option Explicit' https://jkp-ads.com/articles/apideclarations.asp; useful resource for Declare functionsPrivate Const SWP_NOSIZE = &H1, SWP_NOMOVE = &H2, SWP_NOACTIVATE = &H10, SWP_DRAWFRAME = &H20, HWND_TOPMOST = -1, GW_HWNDNEXT = 2Private Const FLAGS As Long = SWP_NOMOVE Or SWP_NOSIZE Or SWP_DRAWFRAME#If VBA7 Then    Private Declare PtrSafe Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As LongPtr, ByVal lpString As String, ByVal cch As LongPtr) As Long    Private Declare PtrSafe Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As LongPtr) As Long    Private Declare PtrSafe Function GetWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal wCmd As Long) As LongPtr    Private Declare PtrSafe Function IsWindowVisible Lib "user32" (ByVal hWnd As LongPtr) As Boolean    Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr    Private Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As LongPtr, ByVal nCmdShow As Long) As Boolean    Private Declare PtrSafe Function SetWindowPos Lib "user32" (ByVal hWnd As LongPtr, ByVal hWndInsertAfter As LongPtr, _        ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long#Else    Private Declare Function GetWindowText Lib "User32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long    Private Declare Function GetWindowTextLength Lib "User32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long    Private Declare Function GetWindow Lib "User32" (ByVal hWnd As Long, ByVal wCmd As Long) As Long    Private Declare Function IsWindowVisible Lib "User32" (ByVal hWnd As Long) As Long    Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long    Private Declare Function ShowWindow Lib "User32" (ByVal hWnd As Long, ByVal nCmdSHow As Long) As Long    Private Declare Function SetWindowPos Lib "User32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, _        ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long#End If#If VBA7 Then    Private Declare PtrSafe Function SetTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr, _        ByVal uElapse As Long, ByVal lpTimerFunc As LongPtr) As LongPtr    Private Declare PtrSafe Function KillTimer Lib "user32" (ByVal hWnd As LongPtr, ByVal nIDEvent As LongPtr) As Long#Else    Private Declare Function SetTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long, _        ByVal uElapse As Long, ByVal lpTimerFunc As Long) As Long    Private Declare Function KillTimer Lib "user32" (ByVal hWnd As Long, ByVal nIDEvent As Long) As Long#End If#If VBA7 Then    'TimerIDs to turn off timers. If a TimerID <> 0 then the timer is running    Public ReminderTimerID As LongPtr        Public Function ReminderStartTimer()        On Error Resume Next        Call ActivateTimer(1, AddressOf ReminderEvent, ReminderTimerID)    End Function        Public Sub ReminderEvent(ByVal hWnd As LongPtr, ByVal uMsg As LongPtr, ByVal idevent As LongPtr, ByVal Systime As LongPtr)        On Error Resume Next        Call EventFunction    End Sub        Private Function EventFunction()        On Error Resume Next        If ReminderTimerID <> 0 Then Call DeactivateTimer(ReminderTimerID)        Dim hRemWnd As LongPtr: FindWindowFromPartialCaption hRemWnd, "Reminder"        If IsWindowVisible(hRemWnd) Then            'ShowWindow hRemWnd, 1                                   ' Activate Window            SetWindowPos hRemWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS   ' Set Modal        End If        Debug.Print TimeInMS() & "; " & hRemWnd    End Function        Private Function FindWindowFromPartialCaption(ByRef hWnd As LongPtr, ByVal PartialCaption As String)        Dim hWndP As LongPtr: hWndP = FindWindow(vbNullString, vbNullString) 'Parent Window        Do While hWndP <> 0            If InStr(GetNameFromHwnd(hWndP), PartialCaption) > 0 Then hWnd = hWndP            If hWnd = hWndP Then Exit Do            hWndP = GetWindow(hWndP, GW_HWNDNEXT)        Loop    End Function        Private Function GetNameFromHwnd(ByRef hWnd As LongPtr) As String        Dim Title As String * 255        GetWindowText hWnd, Title, 255        GetNameFromHwnd = Left(Title, GetWindowTextLength(hWnd))    End Function    Private Function ActivateTimer(ByVal Seconds As Long, FunctionAddress As LongLong, ByRef TimerID As LongPtr) 'The SetTimer call accepts milliseconds        On Error Resume Next        If TimerID = 0 Then TimerID = SetTimer(0, 0, Seconds * 1000, FunctionAddress) 'Check to see if timer is running before call to SetTimer    End Function        Private Function DeactivateTimer(ByRef TimerID As LongLong)        On Error Resume Next        If KillTimer(0&, TimerID) <> 0 Then TimerID = 0    End Function#Else    'TimerIDs to turn off timers. If a TimerID <> 0 then the timer is running    Public ReminderTimerID As Long        Public Sub ReminderEvent(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)        Call EventFunction    End Sub        Private Function ActivateTimer(ByVal Seconds As Long, FunctionAddress As Long, ByRef TimerID As Long) 'The SetTimer call accepts milliseconds        On Error Resume Next        If TimerID = 0 Then TimerID = SetTimer(0, 0, Seconds * 1000, FunctionAddress) 'Check to see if timer is running before call to SetTimer    End Function        Private Function DeactivateTimer(ByRef TimerID As Long)        On Error Resume Next        If KillTimer(0, TimerID) <> 0 Then TimerID = 0    End Function        Private Function EventFunction()        On Error Resume Next        If ReminderTimerID <> 0 Then Call DeactivateTimer(ReminderTimerID)        Dim hRemWnd As Long: FindWindowFromPartialCaption hRemWnd, "Reminder"        If IsWindowVisible(hRemWnd) Then            'ShowWindow hRemWnd, 1                                   ' Activate Window            SetWindowPos hRemWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS   ' Set Modal        End If        Debug.Print TimeInMS() & "; " & hRemWnd    End Function        Private Function FindWindowFromPartialCaption(ByRef hWnd As Long, ByVal PartialCaption As String)        Dim hWndP As Long: hWndP = FindWindow(vbNullString, vbNullString) 'Parent Window        Do While hWndP <> 0            If InStr(GetNameFromHwnd(hWndP), PartialCaption) > 0 Then hWnd = hWndP            If hWnd = hWndP Then Exit Do            hWndP = GetWindow(hWndP, GW_HWNDNEXT)        Loop    End Function        Private Function GetNameFromHwnd(ByRef hWnd As Long) As String        Dim Title As String * 255        GetWindowText hWnd, Title, 255        GetNameFromHwnd = Left(Title, GetWindowTextLength(hWnd))    End Function#End IfPrivate Function TimeInMS() As String    Dim TimeNow As Double: TimeNow = Timer    TimeInMS = Format(Date, "dd/mm/yyyy ") & Format(DateAdd("s", TimeNow, 0), "hh:mm:ss.") & Right(Format(TimeNow, "#0.00"), 2)End Function

Using AutoHotKey you can set the window to be Always On Top without stealing focus of the current window. (Tested with WIn10 / Outlook 2013)

TrayTip Script, Looking for Reminder window to put on top, , 16SetTitleMatchMode  2 ; windows containsloop {  WinWait, Reminder(s),   WinSet, AlwaysOnTop, on, Reminder(s)  WinRestore, Reminder(s)  TrayTip Outlook Reminder, You have an outlook reminder open, , 16  WinWaitClose, Reminder(s), ,30}

I've found a free program called PinMe! that will do exactly what I want. When your Outlook Reminder appears, right click on PinMe! in the system tray and select the Reminder window. This will place a lock icon next to the window. Go ahead Dismiss or Snooze your Reminder. The next time the reminder pops, it should appear in the front of every other window. This will work regardless of Outlook in the foreground or minimized.