web-dev-qa-db-ja.com

他のウィンドウの上にOutlookリマインダーポップアップを作成する方法

他のウィンドウの上にOutlookリマインダーポップアップを作成するにはどうすればよいですか？

長い間オンラインで見た後;この質問に対する満足のいく答えを見つけることができませんでした。

Windows 7およびMicrosoft Outlook 2007+を使用。リマインダーが点滅すると、注意を引くためのモーダルボックスが表示されなくなります。追加のプラグインのインストールが問題になる可能性がある職場（管理者権限）や、静かなシステムを使用している場合、会議出席依頼は見落とされがちです。

サードパーティのプラグイン/アプリを使用するよりも簡単にこれを実装する方法はありますか？

windows-7outlookfocusreminders
18
Tragamor

*最新のマクロについては、アップデート3を参照してください*

しばらく検索したところ、Webサイトで部分的な回答が見つかりましたが、これはソリューションの大部分を提供してくれたようです。 https://superuser.com/questions/251963/how-to-make-Outlook-calendar-reminders-stay-on-top-in-windows-7

ただし、コメントに記載されているように、最初のリマインダーはポップアップに失敗しました。さらにリマインダーがしました。これは、一度インスタンス化されるまでウィンドウが検出されなかったためだと思ったコードに基づいています

これを回避するために、私はタイマーを使用して、ウィンドウが存在するかどうかを定期的にテストし、存在するかどうかを前面に表示することを検討しました。次のWebサイトからコードを取得します。 Outlook VBA-30分ごとにコードを実行

次に、2つのソリューションを結合すると、この問題に対する実用的なソリューションが得られました。

トラストセンターから、マクロの使用を有効にしてから、Outlook（alt + F11）からVisual Basic Editorを開き、「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リマインダー」のあるウィンドウが存在するかどうかをチェックし、そのウィンドウを一番上にバンプします...

[〜＃〜] update [〜＃〜]（Feb 12、2015）：しばらくこれを使用した後、タイマーをトリガーすると現在のウィンドウからフォーカスが削除されるという事実に不快感を覚えました。電子メールを書いているので、それは非常に面倒です。

そのため、タイマーを60秒ごとにのみ実行するようにコードをアップグレードし、最初のアクティブなリマインダを見つけると、タイマーが停止し、セカンダリイベント機能がすぐに使用されてウィンドウフォーカスの変更がアクティブになります。

UPDATE 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

UPDATE 3（2016年8月8日） ：私のアプローチを再考し、観察に基づいて-Outlookが開いている間に作業に最小限の影響を与えるようにコードを再設計しました。私が書いている電子メールからタイマーがフォーカスを奪い、ウィンドウがフォーカスを失うという他の問題が関連している可能性があります。

代わりに、インスタンス化されたリマインダーウィンドウは単に非表示であり、リマインダーが表示されたときに破棄されないと仮定しました。そのため、ウィンドウのグローバルハンドルを保持するので、ウィンドウタイトルを1回だけ見て、リマインダーウィンドウが表示されるかどうかを確認してからモーダルにする必要があります。

また、タイマーはリマインダーウィンドウがトリガーされたときにのみ使用され、機能が実行されるとオフになります。うまくいけば、稼働中に侵入マクロの実行を停止します。

どれがあなたに合っているか見てみましょう...

以下の更新されたコード：次のコードを「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
15
Tragamor

AutoHotKeyを使用すると、現在のウィンドウのフォーカスを奪うことなく、ウィンドウを常に手前に設定できます。 （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
}
12
Eric Labashosky

PinMe！ と呼ばれる無料のプログラムを見つけました。 Outlookリマインダーが表示されたら、PinMeを右クリックします！システムトレイで[リマインダー]ウィンドウを選択します。これにより、ウィンドウの横にロックアイコンが配置されます。リマインダーを破棄またはスヌーズします。次回リマインダーが表示されると、他のすべてのウィンドウの前面に表示されます。これは、フォアグラウンドまたは最小化されたOutlookに関係なく機能します。

4
Sun

Office 2013とWindows 8.1 Proがあります。私が見つけた多くのマクロは、OutlookがReminderダイアログに配置するタイトルの可変的な性質を処理していませんでした。リマインダーが1つある場合、タイトルは「1 Reminder（s）」などです。VB.NETで単純なWindowsフォームアプリケーションを作成しました。これを起動時に読み込み、システムトレイに最小化します。アクティブなコードをトリガーする60タイマーがフォームに追加されています。 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
1
Jack

Eric Labashoskyの答え に触発された後、私は彼の概念をさらに一歩進め、 NotifyWhenMicrosoftOutlookReminderWindowIsOpenアプリ を作成しました。これは無料でダウンロードできます。これは、Outlookリマインダーウィンドウが他のウィンドウの上に表示されるようにする小さな実行可能ファイルであり、ウィンドウが開いたことをユーザーに警告する他のオプションの方法もあります。

1
deadlydog

Outlook 2016には、「他のウィンドウの上にリマインダーを表示する」オプションがあります。 File> Options> Advancedを使用し、Remindersセクションのチェックボックスを使用します。スクリーンショットについては、こちらをご覧ください support.office.com page このオプションは、Outlook 2016の バージョン1804 で追加され、2018年4月25日に「月間チャネル」にリリースされました。

このOutlook 2016オプションでは、最初はすべてのアプリの上にリマインダーが表示されます。私は、他のウィンドウをクリックしても明示的に閉じるまで、リマインダーをkeepしたいです。上のリマインダーをkeepするには、この質問で@Tragamorの 受け入れられた答え を強くお勧めします。しかし、@ Tragamorの答えが複雑すぎるように思われ、リマインダーが最初にのみ表示されることに問題がない場合、Outlook 2016のオプションは非常に簡単です。

1
netjeff

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
0
Evolve_or_Die

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
0
Gullu

最新のOutlookにはこの機能が組み込まれており、同じ答えが https://superuser.com/a/1327856/913992 にあります。

0
Jebarson Jebamony