如何在其他窗口之上制作Outlook提醒弹出窗口

时间：2014-05-29 19:10:17

标签： windows-7 outlook focus reminders

如何在其他窗口之上制作Outlook提醒弹出窗口？

在网上看了很久之后;我无法找到这个问题的满意答案。

使用Windows 7和Microsoft Outlook 2007+;当提醒闪烁时，它不再提供模态框来吸引你的注意力。在安装额外插件（管理员权限）和使用安静系统时，会议请求经常被忽视。

有没有比使用第三方插件/应用程序更容易实现此方法？

9 个答案:

答案 0 :(得分：15)

*有关最新的宏，请参阅更新3 *

经过一段时间的搜索，我在网站上找到了一个部分答案，似乎给了我大部分解决方案; 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打开可视化基本编辑器（alt + F11）我将以下代码添加到＆＃39; ThisOutlookSession＆＃39;模块

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秒，计时器检查一个带有标题的窗口是否提醒＆＃34; 1提醒＆＃34;存在然后碰到它顶部...

更新 （2015年2月12日）：使用一段时间之后我发现触发定时器的真实烦恼从当前窗口中移除焦点。

，当您正在撰写电子邮件时，这是一个巨大的麻烦。

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

更新2 （2015年9月4日）：转换到Outlook 2013后 - 此代码停止了为我工作。我现在使用另一个函数（FindReminderWindow）更新它，查找一系列弹出提醒标题。这在2013年适用于我，适用于2013年以下的版本。

FindReminderWindow函数接受一个值，该值是要逐步查找窗口的迭代次数。如果你经常有比10个弹出窗口更多的提醒，那么你可以在EventMacro子句中增加这个数字......

以下更新的代码： 将以下代码添加到＆＃39; ThisOutlookSession＆＃39;模块

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失去焦点的其他问题可能有关。

相反 - 我认为实例化后的提醒窗口仅仅是隐藏的，并且在显示提醒时不会被销毁;因此，我现在保持窗口的全局句柄，所以我只需要在窗口标题上查看一次，然后检查提醒窗口是否可见，然后再进行模态化。

此外 - 计时器现在仅在触发提醒窗口时使用，然后在功能运行后关闭;希望在工作日停止任何侵入式宏观运行。

看看哪一个适合你，我猜......

以下更新的代码： 将以下代码添加到＆＃39; ThisOutlookSession＆＃39;模块

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

答案 1 :(得分：12)

使用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
}

答案 2 :(得分：4)

我找到了一个名为PinMe!的免费程序，可以完全按照我的意愿行事。出现Outlook提醒时，右键单击PinMe！在系统托盘中，选择“提醒”窗口。这将在窗口旁边放置一个锁定图标。继续关闭或暂停您的提醒。下次提醒弹出时，它应出现在每个其他窗口的前面。无论前台是Outlook还是最小化，这都可以正常工作。

答案 3 :(得分：1)

我有Office 2013和Windows 8.1 Pro。我发现许多宏都没有处理提醒对话框中标题Outlook的变量性质。当你有1个提醒时，标题是＆＃34; 1提醒＆＃34;我在VB.NET中创建了一个简单的Windows窗体应用程序，我在启动时加载并保持最小化到系统托盘。表单中添加了一个60 Timer，用于触发活动代码。当提醒超过0时，对话框将设置为最顶层并移至0,0。

以下是代码：

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

答案 4 :(得分：1)

Outlook 2016现在提供了一个选项，可以在其他窗口上显示提醒＆＃34;。使用文件＆gt;选项＆gt;高级，然后使用“提醒”部分中的复选框。有关屏幕截图，请参阅此support.office.com page。此选项已添加到Outlook 2016的Version 1804中，已发布到＆＃34;每月频道＆＃34;在2018年4月25日。

此Outlook 2016选项仅在最初时将提醒置于所有应用之上。我喜欢保持提醒，直到我明确解雇，即使我点击其他窗口。为了保持提醒，我强烈推荐@ Tragamor accepted answer来解决这个问题。但是，如果@ Tragamor的答案看起来太复杂了，而且您最初只提醒提醒，那么Outlook 2016中的选项非常简单。

答案 5 :(得分：1)

在受到Eric Labashosky's answer的启发之后，我进一步发展了他的概念，并创建了the NotifyWhenMicrosoftOutlookReminderWindowIsOpen app，可以免费下载。它是一个小型可执行文件，可以确保Outlook Reminders窗口出现在其他窗口的顶部，并具有一些其他可选方式来警告用户该窗口已打开。

答案 6 :(得分：0)

即使我仅在Outlook 2013上测试它，这应该适用于不同的Outlook版本。

由于我无法在本地化的英文版本中测试它，您可能需要自定义与搜索提醒窗口相关的代码行，即使在我的回答中，我更改了相关的代码行以便在英语中找到窗口本地化版本。

如果宏在您的英文Outlook版本中有效，请告诉我。

用户可以自由地最小化或关闭提醒窗口，在这种情况下，当新的或现有提醒触发时，提醒窗口将位于最顶层且未激活。

即使没有激活，也会始终更新提醒窗口标题，反映可见提醒的实际数量。

在所有情况下，提醒窗口永远不会窃取焦点，除非显然前景窗口是提醒窗口，除非用户故意选择了提醒窗口。

此宏除了使提醒窗口最顶端外，还会在提醒窗口中选择最近的提醒，您可以自定义此行为，请阅读代码以便能够执行此操作。

当第一次显示窗口时以及新的或现有的提醒再次触发时，宏也会闪烁提醒窗口。

您可以自定义窗口闪烁的次数或与之相关的任何其他参数，应该清楚如何执行此操作。

将下一个代码行粘贴到类模块“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

将下一个代码行粘贴到新的或现有的标准模块中：

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

答案 7 :(得分：0)

最新的Outlook内置了此功能，https://superuser.com/a/1327856/913992

也回答了同样的问题

答案 8 :(得分：0)

只需Alt F11并复制粘贴此代码即可。为我工作

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
相关问题
最新问题