如何使Outlook提醒弹出并保持在其他窗口的顶部 [英] How to make an outlook reminder popup and stay on top of other windows

问题描述

如何弹出Outlook提醒并保持在其他窗口之上？

在网上查找了很长一段时间后，我没有找到这个问题的满意答案。

使用Windows 7和Microsoft Outlook 2007+；当提示闪烁时，它不再提供模式框来吸引您的注意力。在安装其他插件可能有问题的工作中(管理员权限)，以及在使用安静系统时，会议请求通常会被忽略。

是否有更简单的方法来实现此而不使用使用第三方插件/应用？

2021年9月：更新问题标题以指示模态弹出

推荐答案

有关最新宏的信息，请参阅更新4(包含Office 365)

搜索了一会儿后，我在一个网站上找到了部分答案，似乎给了我大部分答案； https://superuser.com/questions/251963/how-to-make-outlook-calendar-reminders-stay-on-top-in-windows-7

但是，正如评论中所指出的，第一个提醒没有弹出，而随后弹出了进一步的提醒。根据代码，我假设这是因为窗口直到实例化一次才被检测到

为解决此问题，我希望使用计时器定期测试窗口是否存在，如果存在，则将其带到前面。 从以下网站获取代码；Outlook VBA - Run a code every half an hour

然后将这两个解决方案融合在一起即可提供此问题的有效解决方案。

从信任中心启用宏，然后从Outlook打开Visual Basic编辑器(ALT+F11)我将以下代码添加到‘ThisOutlookSession’模块

已删除代码

---

更新1(2015年2月12日)

在使用了一段时间之后，我发现触发计时器会将焦点从当前窗口移走，这确实让我很恼火。这是一个巨大的麻烦，因为你正在写一封电子邮件。

因此，我升级了代码，使计时器仅每60秒运行一次，然后在找到第一个活动提醒时停止计时器，然后立即使用辅助事件函数激活窗口焦点更改。

---

更新2(2015年9月4日)

已过渡到Outlook 2013-此代码不再对我起作用。我现在已经使用另一个函数(FindRminderWindow)对其进行了更新，该函数可以查找一系列弹出式提醒字幕。这现在适用于2013年的我，并且应该适用于2013年以下的版本。

FindRminderWindow函数接受一个值，该值是单步执行以查找窗口的迭代次数。如果您的提醒数量通常大于10个弹出窗口，则可以在EventMacro子窗口中增加此数量.

已删除代码

---

更新3(2016年8月8日)

重新考虑了我的方法并根据观察结果重新设计了代码，以尝试在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

然后更新模块代码.

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

---

更新4(2021年9月9日)

过渡到Office 365：现在设置中有一个选项，可以在窗口顶部显示提醒(如下图所示)，那么为什么现在要运行宏将其放在窗口顶部？原因是您可以将其设置为模式提醒框(使用SWP_DRAWFRAME)，因此如果您在程序之间切换，它将保持可见状态，这是普通选项无法实现的

代码应与所有Outlook版本兼容，并允许在它们之间轻松转换(但是，我不能再错误检查非VBA7代码)

在ThisOutlookSession中

Private WithEvents MyReminders As Outlook.Reminders

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

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

在模块中

Option Explicit
' https://jkp-ads.com/articles/apideclarations.asp; useful resource for Declare functions

Private Const SWP_NOSIZE = &H1, SWP_NOMOVE = &H2, SWP_NOACTIVATE = &H10, SWP_DRAWFRAME = &H20, HWND_TOPMOST = -1, GW_HWNDNEXT = 2
Private 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 Function ReminderStartTimer()
        On Error Resume Next
        Call ActivateTimer(1, AddressOf ReminderEvent, ReminderTimerID)
    End Function

    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 If

Private 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

这篇关于如何使Outlook提醒弹出并保持在其他窗口的顶部的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！