如何在 Outlook 2021 中弹出 Outlook 提醒并保持领先地位

问：

我正在尝试弹出 Outlook 提醒并在 Outlook 2021 中保持领先地位。

一个简单的宏对我有用，但由于如何弹出 Outlook 提醒并保持在其他窗口之上中描述的缺点，它不是很有帮助。

从上面帖子中接受的答案中，我将以下代码复制到“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

在“模块 1”中，复制了以下代码：

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

运行时错误消失了，上面的代码现在可以工作了。很可能是复制和粘贴错误。