How do you make an outlook reminder popup on top of other windows

windows-7 outlook focus reminders
Tragamor picture Tragamor · May 29, 2014 · Viewed 48.8k times · Source

How do you make an outlook reminder popup on top of other windows?

After looking online for a long while; I wasn't able to find a satisfactory answer to this question.

Using Windows 7 and Microsoft Outlook 2007+; when a reminder flashes up, it no longer gives a modal box to grab your attention. At work where additional plugins can be problematic to install (admin rights) and when using a quiet system, meeting requests are often overlooked.

Is there an easier way to implement this than using third party plugins/apps?

Answer

Tragamor picture Tragamor · May 30, 2014

* For the latest macro please see update 3 *

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

Private Sub Application_Startup()
    Call ActivateTimer(5) 'Set timer to go off every 5 seconds
End Sub

Private Sub Application_Quit()
  If TimerID <> 0 Then Call DeactivateTimer 'Turn off timer upon quitting 
End Sub

Then added a module and added the following code

Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent _
As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long

Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent _
As Long) As Long

Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName _
As String, ByVal lpWindowName As String) 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

Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const FLAGS As Long = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1

Public TimerID As Long 'Need a timer ID to eventually turn off the timer. 
' If the timer ID <> 0 then the timer is running

Public Sub ActivateTimer(ByVal nSeconds As Long)
    nSeconds = nSeconds * 1000 
    'The SetTimer call accepts milliseconds, so convert from seconds
    If TimerID <> 0 Then Call DeactivateTimer 
    'Check to see if timer is running before call to SetTimer
    TimerID = SetTimer(0, 0, nSeconds, AddressOf TriggerTimer)
    If TimerID = 0 Then MsgBox "The timer failed to activate."
End Sub

Public Sub DeactivateTimer()
    Dim lSuccess As Long
    lSuccess = KillTimer(0, TimerID)
    If lSuccess = 0 Then
        MsgBox "The timer failed to deactivate."
    Else
        TimerID = 0
    End If
End Sub

Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal idevent As Long, ByVal Systime As Long)
    Call EventMacro
End Sub

Public Sub EventMacro()
    Dim ReminderWindowHWnd As Variant
    On Error Resume Next
    ReminderWindowHWnd = FindWindowA(vbNullString, "1 Reminder")
    If ReminderWindowHWnd <> 0 Then SetWindowPos ReminderWindowHWnd, _
    HWND_TOPMOST, 0, 0, 0, 0, FLAGS
    ReminderWindowHWnd = Nothing
End Sub

So that's it; every 5 seconds, the timer checks whether a window with a caption "1 Reminder" exists then bumps it to the top...

UPDATE (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...

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

Private Sub Application_Startup()
    Call ActivateTimer(60) 'Set timer to go off every 60 seconds
End Sub

Private Sub Application_Quit()
    If TimerID <> 0 Then Call DeactivateTimer 'Turn off timer upon quitting
End Sub

Private Sub Application_Reminder(ByVal Item As Object)
    Call EventMacro
End Sub

Then the updated module code...

Declare Function SetTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent _
As Long, ByVal uElapse As Long, ByVal lpTimerfunc As Long) As Long

Declare Function KillTimer Lib "user32" (ByVal hwnd As Long, ByVal nIDEvent _
As Long) As Long

Private Declare Function FindWindowA Lib "user32" (ByVal lpClassName _
As String, ByVal lpWindowName As String) 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

Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const FLAGS As Long = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1

Public TimerID As Long 'Need a timer ID to eventually turn off the timer. 
' If the timer ID <> 0 then the timer is running

Public Sub ActivateTimer(ByVal nSeconds As Long)
    nSeconds = nSeconds * 1000 
    'The SetTimer call accepts milliseconds, so convert from seconds
    If TimerID <> 0 Then Call DeactivateTimer 
    'Check to see if timer is running before call to SetTimer
    TimerID = SetTimer(0, 0, nSeconds, AddressOf TriggerTimer)
    If TimerID = 0 Then MsgBox "The timer failed to activate."
End Sub

Public Sub DeactivateTimer()
    Dim lSuccess As Long
    lSuccess = KillTimer(0, TimerID)
    If lSuccess = 0 Then
        MsgBox "The timer failed to deactivate."
    Else
        TimerID = 0
    End If
End Sub

Public Sub TriggerTimer(ByVal hwnd As Long, ByVal uMsg As Long, _
ByVal idevent As Long, ByVal Systime As Long)
    Call EventMacro
End Sub

Public Sub EventMacro()
    Dim ReminderWindowHWnd As Variant
    On Error Resume Next
    ReminderWindowHWnd = FindReminderWindow(10)
    If ReminderWindowHWnd <> 0 Then
        SetWindowPos ReminderWindowHWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
        If TimerID <> 0 Then Call DeactivateTimer
    End If
    ReminderWindowHWnd = Nothing
End Sub

Private Function FindReminderWindow(iUB As Integer) As Variant
    Dim i As Integer: i = 1
    FindReminderWindow = FindWindowA(vbNullString, "1 Reminder")
    Do While i < iUB And FindReminderWindow = 0
        FindReminderWindow = FindWindowA(vbNullString, i & " Reminder(s)")
        i = i + 1
    Loop
End Function

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.Reminders

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

Private Sub MyReminders_ReminderFire(ByVal ReminderObject As Reminder)
    On Error Resume Next
    Call ActivateTimer(1)
End Sub

Then the updated module code...

Option Explicit

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

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

Private Const SWP_NOSIZE = &H1
Private Const SWP_NOMOVE = &H2
Private Const FLAGS As Long = SWP_NOMOVE Or SWP_NOSIZE
Private Const HWND_TOPMOST = -1

Public TimerID As Long 'Need a timer ID to turn off the timer. If the timer ID <> 0 then the timer is running
Public hRemWnd As Long 'Store the handle of the reminder window

Public 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 Sub

Public Sub DeactivateTimer()
    On Error Resume Next
    Dim Success As Long: Success = KillTimer(0, TimerID)
    If Success <> 0 Then TimerID = 0
End Sub

Public Sub TriggerEvent(ByVal hWnd As Long, ByVal uMsg As Long, ByVal idevent As Long, ByVal Systime As Long)
    Call EventFunction
End Sub

Public 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 If
End Function

Public 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, 1
End Function

Related questions

Getting/Creating an Outlook Application in Windows 7

I'm trying to get the current running version of Outlook or start up Outlook in case it is not running, but I am having some issues in getting or creating the Outlook Application object in Windows 7. I think it has …

Read More
How to set java_home on Windows 7?

I went to the Environment Variables in 'System' in the control panel and made two new variables, one for user variables and one for system variables. Both were named JAVA_HOME and both pointing to C:\Sun\SDK\jdk\bin …

Read More
How do I register a DLL file on Windows 7 64-bit?

I have tried to use the following code: cd c:\windows\system32 regsvr32.exe dllname.ax But this is not working for me. How can I register a DLL file on Windows 7 with a 64-bit processor?

Read More