如何在其他窗口之上制作Outlook提醒弹出窗口?
在网上看了很久之后; 我无法找到这个问题的满意答案.
使用Windows 7和Microsoft Outlook 2007+; 当提醒闪烁时,它不再提供模态框来吸引你的注意力.在其他插件可能有问题需要安装(管理员权限)以及使用安静系统时,会议请求经常被忽略.
有没有比使用第三方插件/应用程序更容易实现此方法?
使用AutoHotKey,您可以将窗口设置为Always On Top而不会窃取当前窗口的焦点.(使用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 }
*有关最新的宏,请参阅更新3*
在搜索了一段时间后,我在网站上找到了部分答案,似乎给了我大部分解决方案; https://superuser.com/questions/251963/how-to-make-outlook-calendar-reminders-stay-on-top-in-windows-7
然而,如评论中所述,第一个提醒未能弹出; 然后进一步提醒.根据我假设的代码,这是因为在实例化一次之前未检测到窗口
为了解决这个问题,我希望使用一个计时器来定期测试窗口是否存在以及是否存在,然后将其带到前面.从以下网站获取代码; Outlook VBA - 每半小时运行一次代码
然后将两个解决方案融合在一起为这个问题提供了可行的解决方案.
从信任中心,我启用了宏的使用,然后从Outlook打开可视化基本编辑器(alt + F11)我将以下代码添加到'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
然后添加了一个模块并添加了以下代码
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
就是这样了; 每隔5秒,计时器检查一个带有标题"1 Reminder"的窗口是否存在,然后将其碰到顶部...
更新 (2015年2月12日):在使用了一段时间后,我发现了一个真正的烦恼,即触发定时器会从当前窗口中移除焦点.当你写一封电子邮件时,这是一个巨大的麻烦.
因此,我升级了代码,使得计时器仅每60秒运行一次,然后在找到第一个活动提醒时,停止计时器,然后立即使用辅助事件功能来激活窗口焦点变化.
更新2 (2015年9月4日):已转换到Outlook 2013 - 此代码停止为我工作.我现在使用另一个函数(FindReminderWindow)更新它,查找一系列弹出提醒标题.这在2013年对我有用,应该适用于2013年以下的版本.
FindReminderWindow函数接受一个值,该值是要逐步查找窗口的迭代次数.如果你经常有比10个弹出窗口更多的提醒,那么你可以在EventMacro子句中增加这个数字......
更新后面的代码:将以下代码添加到'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
然后更新的模块代码......
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
更新3 (2016年8月8日):重新思考我的方法并基于观察 - 我重新设计了代码,试图在Outlook开放时对工作产生最小的影响; 我会发现计时器仍然把注意力从我正在写的电子邮件上移开,并且可能与Windows失去焦点的其他问题可能有关.
相反 - 我假设一旦实例化的提醒窗口只是隐藏而不是在显示提醒时被销毁; 因此,我现在保持窗口的全局句柄,所以我只需要在窗口标题上查看一次,然后检查提醒窗口是否可见,然后再进行模态化.
此外 - 计时器现在仅在触发提醒窗口时使用,然后在功能运行后关闭; 希望在工作日停止任何侵入式宏的运行.
看看哪一个适合你我猜...
更新后面的代码:将以下代码添加到'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