windows 7 - ¿Cómo se hace una ventana emergente de recordatorio de perspectiva sobre otras ventanas?

windows-7 outlook

Question

¿Cómo se hace una ventana emergente de recordatorio de perspectiva en la parte superior de otras ventanas?

Después de buscar en línea durante mucho tiempo; No pude encontrar una respuesta satisfactoria a esta pregunta.

Usando Windows 7 y Microsoft Outlook 2007+; cuando un recordatorio se ilumina, ya no da una caja modal para captar su atención. En el trabajo donde los complementos adicionales pueden ser problemáticos de instalar (derechos de administrador) y al usar un sistema silencioso, las convocatorias de reuniones a menudo se pasan por alto.

¿Hay una manera más fácil de implementar esto que usar complementos / aplicaciones de terceros?

Answer 1

¡He encontrado un programa gratuito llamado PinMe! Eso hará exactamente lo que yo quiero. Cuando aparezca su recordatorio de Outlook, haga clic derecho en PinMe! en la bandeja del sistema y seleccione la ventana Recordatorio. Esto colocará un icono de candado al lado de la ventana. Adelante Descartar o Posponer su recordatorio. La próxima vez que aparezca el recordatorio, debería aparecer en la parte frontal de todas las demás ventanas. Esto funcionará independientemente de Outlook en primer plano o minimizado.

Answer 2

Después de inspirarme en la respuesta de Eric Labashosky , di un paso más en su concepto y creé la aplicación NotifyWhenMicrosoftOutlookReminderWindowIsOpen , que puede descargar de forma gratuita. Es un pequeño archivo ejecutable que puede garantizar que la ventana de Recordatorios de Outlook aparezca encima de otras ventanas, además de tener otras formas opcionales de alertar al usuario de que la ventana se ha abierto.

Answer 3

Esto debería funcionar en diferentes versiones de Outlook incluso si lo probé solo en Outlook 2013.

Como no puedo probarlo en una versión localizada en inglés, es posible que deba personalizar las líneas de código relacionadas con la búsqueda en la ventana de recordatorios incluso si, en mi respuesta, cambié las líneas de código relacionadas para encontrar la ventana en la versión localizada en inglés.

Avísame si la macro funciona en tu versión de Outlook en inglés.

El usuario tiene la libertad de minimizar o cerrar la ventana de recordatorios, en cuyo caso, cuando se active un recordatorio nuevo o existente, la ventana de recordatorios será la más alta y no estará activada.

El título de la ventana de recordatorios siempre se actualizará reflejando el número real de recordatorios visibles, incluso sin activarlo.

En todos los casos, la ventana de recordatorios nunca robará el foco a menos que, obviamente, la ventana de primer plano sea la ventana de recordatorios, es decir, a menos que el usuario haya seleccionado deliberadamente la ventana de recordatorios.

Esta macro, además de hacer que la ventana de recordatorios aparezca en la parte superior, también seleccionará el recordatorio más reciente en la ventana de recordatorio, puede personalizar este comportamiento, lea el código para poder hacerlo.

La macro también muestra la ventana de recordatorios cuando se muestra la ventana por primera vez y cada vez que se dispara un recordatorio nuevo o existente.

Puede personalizar cuántas veces parpadea la ventana o cualquier otro parámetro relacionado con ella, debe quedar claro cómo hacerlo.

Pegue las siguientes líneas de código en el módulo de clase ''ThisOutlookSession'':

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (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 Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Private Declare Function FlashWindowEx Lib "user32" (FWInfo As FLASHWINFO) As Boolean

Private Const FLASHW_STOP = 0
Private Const FLASHW_CAPTION = 1
Private Const FLASHW_TRAY = 2
Private Const FLASHW_ALL = FLASHW_CAPTION Or FLASHW_TRAY
Private Const FLASHW_TIMER = 4
Private Const FLASHW_TIMERNOFG = 12

Private Type FLASHWINFO
    cbSize As Long
    hwnd As Long
    dwFlags As Long
    uCount As Long
    dwTimeout As Long
End Type

Private Const HWND_TOPMOST = -1
Private Const HWND_NOTOPMOST = -2
Private Const HWND_TOP = 0
Private Const HWND_BOTTOM = 1
Private Const SWP_NOSIZE = 1
Private Const SWP_NOMOVE = 2
Private Const SWP_NOACTIVATE = 16
Private Const SWP_DRAWFRAME = 32
Private Const SWP_NOOWNERZORDER = 512
Private Const SWP_NOZORDER = 4
Private Const SWP_SHOWWINDOW = 64

Private Existing_reminders_window As Boolean

Private WithEvents Rmds As Reminders

Public Reminders_window As Long

Private Sub Application_Reminder(ByVal Item As Object)
    If Existing_reminders_window = False Then
        Set Rmds = Application.Reminders
        ''In order to create the reminders window
        ActiveExplorer.CommandBars.ExecuteMso ("ShowRemindersWindow")
        Reminders_window = FindWindow("#32770", "0 Reminder(s)")
        If Reminders_window = 0 Then
            Reminders_window = FindWindow("#32770", "0 Reminder")
            If Reminders_window = 0 Then
                Reminders_window = FindWindow("#32770", "0 Reminder ")
            End If      
        End If
        ''To prevent stealing focus in case Outlook was in the foreground
        ShowWindow Reminders_window, 0
        SetWindowPos Reminders_window, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE
        Existing_reminders_window = True
    End If
End Sub
Private Sub Rmds_BeforeReminderShow(Cancel As Boolean)
    Dim FWInfo As FLASHWINFO
    If Existing_reminders_window = True Then
        Cancel = True
        With FWInfo
             .cbSize = 20
             .hwnd = Reminders_window
             .dwFlags = FLASHW_CAPTION
             .uCount = 4
             .dwTimeout = 0
        End With
        ''In case the reminders window was not the highest topmost. This will not work on Windows 10 if the task manager window is topmost, the task manager and some other system windows have special z position
        SetWindowPos Reminders_window, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOSIZE Or SWP_NOMOVE Or SWP_NOACTIVATE
        ShowWindow Reminders_window, 4
        Select_specific_reminder
        FlashWindowEx FWInfo
    End If
End Sub

Pegue las siguientes líneas de código en un módulo estándar nuevo o existente:

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Long) As Long
Private Declare Function GetClassName Lib "user32" Alias "GetClassNameA" (ByVal hwnd As Long, ByVal lpClassName As String, ByVal nMaxCount As Long) As Long
Private Declare Function EnumChildWindows Lib "user32" (ByVal hWndParent As Long, ByVal lpEnumFunc As Long, ByVal lParam As Long) As Long

Private Const WM_CHAR = &H102
Private Const VK_HOME = &H24
Private Const VK_END = &H23
Private Const WM_KEYDOWN = &H100
Private Const WM_KEYUP = &H101

Public Sub Select_specific_reminder()
    Dim Retval As Long
    Retval = EnumChildWindows(ThisOutlookSession.Reminders_window, AddressOf EnumChildProc, 0)
End Sub
Private Function EnumChildProc(ByVal hwnd As Long, ByVal lParam As Long) As Long
    Dim Nome_classe As String
    Nome_classe = Space$(256)
    GetClassName hwnd, Nome_classe, 256
    If InStr(Nome_classe, "SysListView32") Then
    ''You can customize the next code line in order to select a specific reminder
        SendMessage hwnd, WM_KEYDOWN, VK_HOME, ByVal 0&
    End If
    EnumChildProc = 1
End Function

Answer 4

La última versión de Outlook tiene esta característica incorporada y la misma se responde en https://superuser.com/a/1327856/913992

Answer 5

Outlook 2016 ahora ofrece una opción para "Mostrar recordatorios en la parte superior de otras ventanas". Use Archivo> Opciones> Avanzadas , y luego use la casilla de verificación en la sección Recordatorios. Vea esta página de support.office.com para la captura de pantalla. Esta opción se agregó en la Versión 1804 de Outlook 2016, lanzada al "canal mensual" el 25 de abril de 2018.

Esta opción de Outlook 2016 coloca el recordatorio sobre todas las aplicaciones solo inicialmente. Me gusta mantener el recordatorio en la parte superior hasta que lo rechace explícitamente, incluso si hago clic en otra ventana. Para mantener el recordatorio en la parte superior, recomiendo la respuesta aceptada de @ Tragamor a esta pregunta. Pero si la respuesta de @ Tragamor parece demasiado complicada, y está de acuerdo con que el recordatorio está en primer lugar solo inicialmente, la opción ahora en Outlook 2016 es muy simple.

Answer 6

Solo Alt F11 y copia este código ... Trabaja para mi

Option Explicit

Private Declare Function FindWindow Lib "User32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
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 Boolean

Private Const GW_HWNDNEXT = 2

Private Declare PtrSafe Function FindWindowA Lib "User32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare PtrSafe 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

Private Sub Application_Reminder(ByVal Item As Object)
Dim ReminderWindowHWnd As Variant
On Error Resume Next
  Dim lhWndP As Long
    If GetHandleFromPartialCaption(lhWndP, "Reminder") = True Then
        SetWindowPos lhWndP, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
    End If

End Sub

Private Function GetHandleFromPartialCaption(ByRef lWnd As Long, ByVal sCaption As String) As Boolean

     Dim lhWndP As Long
        Dim sStr As String
        GetHandleFromPartialCaption = False
        lhWndP = FindWindow(vbNullString, vbNullString) ''PARENT WINDOW
        Do While lhWndP <> 0
            sStr = String(GetWindowTextLength(lhWndP) + 1, Chr$(0))
            GetWindowText lhWndP, sStr, Len(sStr)
            sStr = Left$(sStr, Len(sStr) - 1)
            If InStr(1, sStr, sCaption) > 0 Then
                GetHandleFromPartialCaption = True
                lWnd = lhWndP
                Exit Do
            End If
            lhWndP = GetWindow(lhWndP, GW_HWNDNEXT)
        Loop
     End Function

Answer 7

Tengo Office 2013 y Windows 8.1 Pro. Muchas de las macros que encontré no manejaban la naturaleza variable del título que Outlook coloca en el cuadro de diálogo Recordatorio. Cuando tiene 1 recordatorio, el título es "1 Recordatorio (s)", etc. Creé una aplicación de formularios de Windows simple en VB.NET, que cargo al inicio y mantengo minimizada en la bandeja del sistema. Hay un temporizador 60 agregado al formulario que activa el código activo. Cuando hay más de 0 recordatorios, el cuadro de diálogo se establecerá en la parte superior y se moverá a 0,0.

Aquí está el código:

Imports System.Runtime.InteropServices
Imports System.Text

Module Module1
    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)>
    Public Function FindWindowEx(ByVal parentHandle As IntPtr, ByVal childAfter As IntPtr, ByVal lclassName As String, ByVal windowTitle As String) As IntPtr
    End Function

    <DllImport("user32.dll", SetLastError:=True)> _
    Public Function SetWindowPos(ByVal hWnd As IntPtr, ByVal hWndInsertAfter As IntPtr, ByVal X As Integer, ByVal Y As Integer, ByVal cx As Integer, ByVal cy As Integer, ByVal uFlags As Integer) As Boolean
    End Function

    <DllImport("user32.dll", SetLastError:=True, CharSet:=CharSet.Auto)> _
    Public Function GetWindowText(ByVal hwnd As IntPtr, ByVal lpString As StringBuilder, ByVal cch As Integer) As Integer
    End Function
End Module

Public Class Form1
    Private Sub Timer1_Tick(sender As Object, e As EventArgs) Handles Timer1.Tick
        Dim titleString As String = ""

        Dim nullHandle As New IntPtr
        Dim windowHandle As New IntPtr
        Dim titleLength As Long

        Try
            Do
                Dim sb As New StringBuilder
                sb.Capacity = 512
                Dim prevHandle As IntPtr = windowHandle
                windowHandle = FindWindowEx(nullHandle, prevHandle, "#32770", vbNullString)

                If windowHandle <> 0 And windowHandle <> nullHandle Then
                    titleLength = GetWindowText(windowHandle, sb, 256)

                    If titleLength > 0 Then
                        titleString = sb.ToString

                        Dim stringPos As Integer = InStr(titleString, "Reminde", CompareMethod.Text)

                        If stringPos Then
                            Dim reminderCount As Integer = Val(Mid(titleString, 1, 2))
                            If reminderCount > 0 Then
                                Dim baseWindow As IntPtr = -1 ''-1 is the topmost position
                                SetWindowPos(windowHandle, baseWindow, 0, 0, 100, 100, &H41)
                            End If
                            Exit Sub
                        End If
                    End If
                Else
                    Exit Sub
                End If
            Loop
        Catch ex As Exception
            MsgBox(ex.Message.ToString)
        End Try
    End Sub

    Private Sub ToolStripMenuItem1_Click(sender As Object, e As EventArgs) Handles ToolStripMenuItem1.Click
        Me.Close()
    End Sub

    Private Sub Form1_Shown(sender As Object, e As EventArgs) Handles Me.Shown
        Me.Hide()
    End Sub
End Class

Answer 8

Usando AutoHotKey puede configurar la ventana para estar siempre arriba sin robar el foco de la ventana actual. (Probado con WIn10 / Outlook 2013)

TrayTip Script, Looking for Reminder window to put on top, , 16
SetTitleMatchMode  2 ; windows contains
loop {
  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
}

Answer 9

* Para la última macro, por favor vea la actualización 3 *

Después de buscar por un tiempo encontré una respuesta parcial en un sitio web que parecía darme la mayor parte de la solución; https://superuser.com/questions/251963/how-to-make-outlook-calendar-reminders-stay-on-top-in-windows-7

Sin embargo, como se señaló en los comentarios, el primer recordatorio no se abrió; mientras que otros recordatorios luego lo hicieron. Según el código, asumí que esto se debía a que la ventana no se detectó hasta que se había instanciado una vez.

Para solucionar esto, busqué un temporizador para probar periódicamente si la ventana estaba presente y si estaba, y luego llevarla al frente. Tomando el código del siguiente sitio web; Outlook VBA - Ejecutar un código cada media hora

Luego, fusionar las dos soluciones juntas dio una solución funcional a este problema.

Desde el centro de confianza, habilité el uso de macros y luego abrí el editor visual básico de Outlook (alt + F11). Agregué el siguiente código al módulo ''ThisOutlookSession''

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

Luego agregó un módulo y agregó el siguiente código.

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

Eso es todo; cada 5 segundos, el temporizador comprueba si existe una ventana con un título "1 Recordatorio" y luego la coloca en la parte superior ...

ACTUALIZACIÓN (12 de febrero de 2015) : después de usar esto por un tiempo, encontré una verdadera molestia con el hecho de que al activar el temporizador se elimina el enfoque de la ventana actual. Es una molestia masiva mientras escribes un correo electrónico.

Como tal, actualicé el código para que el temporizador solo se ejecute cada 60 segundos, luego de encontrar el primer recordatorio activo, el temporizador se detiene y la función de evento secundario se usa de inmediato para activar el cambio de enfoque de la ventana.

ACTUALIZACIÓN 2 (4 de septiembre de 2015) : Habiendo realizado la transición a Outlook 2013, este código dejó de funcionar para mí. Ahora lo he actualizado con una función adicional (FindReminderWindow) que busca un rango de títulos de recordatorios emergentes. Esto ahora funciona para mí en 2013 y debería funcionar para versiones inferiores a 2013.

La función FindReminderWindow toma un valor que es el número de iteraciones que se deben recorrer para encontrar la ventana. Si habitualmente tiene un número mayor de recordatorios que 10 ventanas emergentes, puede aumentar este número en el sub de EventMacro ...

Código actualizado a continuación: agregue el siguiente código al módulo ''ThisOutlookSession''

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

Luego el código del módulo actualizado ...

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

ACTUALIZACIÓN 3 (8 de agosto de 2016) : Después de haber repensado mi enfoque y basado en la observación, rediseñé el código para intentar tener un impacto mínimo en el trabajo mientras Outlook estaba abierto. Descubriría que el cronómetro aún estaba alejado de los correos electrónicos que estaba escribiendo y posiblemente otros problemas con la pérdida de enfoque de Windows podrían estar relacionados.

En cambio, asumí que la ventana de recordatorios una vez que se creaba una instancia estaba simplemente oculta y no se destruye cuando se muestran los recordatorios; como tal, ahora mantengo un identificador global de la ventana, por lo que solo debo mirar los títulos de la ventana y luego verificar si la ventana de recordatorios es visible antes de hacerla modal.

Además, el temporizador ahora solo se emplea cuando se activa la ventana de recordatorios, luego se apaga una vez que la función se ha ejecutado; Esperemos que detenga cualquier macro intrusivo durante la jornada laboral.

Ver cuál funciona para ti, supongo ...

Código actualizado a continuación: agregue el siguiente código al módulo ''ThisOutlookSession''

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

Luego el código del módulo actualizado ...

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