Как заставить напоминания Календаря Outlook оставаться на вершине в Windows 7

Я только начинаю использовать Windows 7, и я хочу знать, как заставить мои напоминания Outlook всплывать и показывать себя заметно. Они продолжают открываться незаметно, как еще одно окно в стеке Outlook на панели задач. В результате я продолжаю упускать из виду их, потому что они всплывают позади всего остального.

Как я могу сделать так, чтобы их было легче пропустить?

(Очевидно, что обычно не нужно, чтобы противные приложения выдвигались на первый план. Но есть несколько мест, где такое поведение желательно, и напоминания календаря Outlook являются одним из них.)

У меня была та же проблема с Outlook 2010. Используйте шаги, упомянутые ниже, это работает как шарм. Не забудьте включить все макросы: Центр управления безопасностью> Настройки макроса.

• Создайте цифровой сертификат на потом: нажмите «Пуск» и введите «сертификат», выберите «Цифровой сертификат для проектов VBA».
• Введите имя для вашего сертификата. Нажмите ОК. Откройте Outlook и нажмите Alt+, F11чтобы запустить редактор VBA.
• В дереве слева разверните «Объекты Microsoft Office Outlook» и дважды щелкните «ThisOutlookSession».

• Вставьте в этот код:

  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
  ReminderWindowHWnd = FindWindowA(vbNullString, "1 Reminder")
  SetWindowPos ReminderWindowHWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
  
  End Sub
  

• Подпишите макрос, чтобы он работал: «Инструменты»> «Цифровая подпись» ... и выберите сертификат, созданный ранее.

• Закройте окно VBA
• Включить все макросы в меню «Файл»> «Параметры»> «Центр управления безопасностью»> «Настройки центра управления безопасностью»> «Настройки макроса»

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
}

AHK Script - Скомпилированный EXE

Лучший ответ, который я нашел, здесь: как заставить напоминания о встречах в Outlook снова всплывать перед другими окнами с помощью простого VBA.

Это влечет за собой добавление нескольких строк простого кода VBA в «ThisOutlookSession». Теперь каждый раз появляется окно. Намного лучше.

• Создать цифровой сертификат на потом
• Нажмите «Пуск» и введите «сертификат», выберите «Цифровой сертификат для проектов VBA»
• Введите имя для вашего сертификата
• Готово
• Откройте Outlook и нажмите Alt + F11, чтобы запустить редактор VBA.
• В дереве слева разверните «Объекты Microsoft Office Outlook» и дважды щелкните «ThisOutlookSession».

• Вставьте этот код, изменив текст в кавычках в соответствии с вашими предпочтениями. Оставьте цитаты в.

  Private Sub Application_Reminder(ByVal Item As Object)
  
  
      If TypeOf Item Is AppointmentItem Then
      MsgBox "Message text", vbSystemModal, "Message title"
      End If
  
  
  End Sub
  

• Подпишите макрос, чтобы он работал, перейдя в Инструменты> Цифровая подпись ... и выбрав сертификат, который вы создали ранее.

• Закройте окно VBA

Начиная с версии 1803 (февраль 2018 года) теперь доступна опция «Показывать напоминания поверх других окон». По-видимому, он не включен по умолчанию.

Выхода нет. Наша компания пыталась передать его непосредственно Microsoft. Люди делают здесь один неприятный звук, чтобы заметить это. Но Microsoft сказала нам, что это дизайн.

То же, что и в ответе Гуллу выше, но с изменением, чтобы приспособить другое название окна:

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

'// TO ACCOUNT FOR WINDOW TITLE CHANGING WITH NOTIFICATION COUNT:
Private Sub Application_Reminder(ByVal Item As Object)
    Dim ReminderWindowHWnd As Variant
    'On Error Resume Next
    On Error GoTo err
    'Loop 25 times as FindWindowA needs exact title which varies according to number of reminder items...
    Dim iReminderCount As Integer
    For iReminderCount = 1 To 25
        'Try two syntaxes...
        ReminderWindowHWnd = FindWindowA(vbNullString, iReminderCount & " Reminder"): SetWindowPos ReminderWindowHWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
        ReminderWindowHWnd = FindWindowA(vbNullString, iReminderCount & " Reminder(s)"): SetWindowPos ReminderWindowHWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
    Next
Exit Sub
err:
    Debug.Print err.Number & " - " & err.Description & " (iReminderCount = " & iReminderCount & ")"
    Resume Next
End Sub

Это меня тоже беспокоило. После некоторых интенсивных поисков я нашел частичный ответ: http://www.pcreview.co.uk/forums/hidden-outlook-reminders-t3972914.html

Если вы измените настройку «Кнопки панели задач» в «Свойствах панели задач и меню Пуск» на «Никогда не комбинировать», тогда группа разделится, и всплывающее окно с напоминанием появится перед всем, что у вас будет открыто.

Я попытался проверить это и обнаружил, что это противоречиво; один раз он оставался скрытым за тем, над чем я работал, а другой раз выскочил вперед. В обоих случаях на панели задач был значок, который выглядел не так, как в самом Outlook, поэтому, по крайней мере, был шанс, что я это заметил.

Я использовал Filebox eXtender, и когда появляется первое напоминание, я открываю его и нажимаю на новый значок булавки в правом верхнем углу панели заголовка. Затем, когда приходит следующее напоминание, оно появляется на переднем плане ...

Я нашел надстройку под названием ShowReminders ( http://www.sagelamp.com/pages/showreminders.aspx ), которая выводит окно напоминаний вверх. Это даже работает, когда вы минимизируете окно напоминания.

Я наконец-то нашел простое решение, используя Outlook VBA и простой EXE.

Вот, как никогда не пропустить встречу встречи перспективы.

Почему отдельное приложение exe только для этой цели? Ну, у меня было большое красное поле, встроенное в VBA, но это решение было полно проблем (я полагаю, это потому, что я должен использовать hwnd и другое необычное системное свойство, чтобы держать красное красное поле сверху). Итак, чтобы упростить задачу, почему бы не использовать базовый EXE-файл, который выполняет одну задачу. Вы можете использовать бесплатные инструменты от Microsoft (Visual Studio Community 2015 бесплатно).

Это код EXE. простое приложение формы окна с одной формой. Скомпилируйте этот код.

Imports System.Timers
Public Class Form1
    Dim tTimer As New Timer
    Public Sub New()
        InitializeComponent()
        Me.StartPosition = Windows.Forms.FormStartPosition.CenterScreen
        Me.TopMost = True
        Me.TopLevel = True
    End Sub
    Private Sub Form1_DoubleClick(sender As Object, e As EventArgs) Handles Me.DoubleClick
        Application.Exit()
    End Sub 
    Private Sub Form1_Shown(sender As Object, e As EventArgs) Handles Me.Shown
        flashingQuick()
    End Sub
    Sub flashingQuick()
        tTimer.Start()
        AddHandler tTimer.Elapsed, New ElapsedEventHandler(AddressOf TimerTick)
    End Sub
    Sub TimerTick(ByVal source As [Object], ByVal e As ElapsedEventArgs)
        Dim theTimer As System.Timers.Timer = DirectCast(source, System.Timers.Timer)
        theTimer.Interval = 500
        theTimer.Enabled = True
        If Me.BackColor = System.Drawing.SystemColors.Control Then
            Me.BackColor = Color.Red
        Else
            Me.BackColor = System.Drawing.SystemColors.Control
        End If
    End Sub
End Class

И это все, что мне нужно в мировоззрении VBA. Поместите это в ThisOutlookSession

Private Sub Application_Reminder(ByVal Item As Object)
    On Error Resume Next
    If Item.MessageClass <> "IPM.Appointment" Then
      Exit Sub
    End If
    Dim sAPPData As String
    Dim sFileName As String
    sAPPData = Environ("AppData")
    sFileName = "\Microsoft\Windows\Start Menu\Programs\BigRedBox\BigRedBox.exe"
    If Dir(sAPPData & sFileName) <> "" Then
        Call Shell(sAPPData & sFileName)
    End If
End Sub

Это расширенная версия ответа tbone, которая работает на немецких версиях.

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 Declare PtrSafe Function BringWindowToTop Lib "user32" (ByVal hwnd As Long) As Boolean
Private Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Boolean
Private Declare PtrSafe Function SetFocus Lib "user32" (ByVal hwnd 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 GoTo err
    'Loop 25 times as FindWindowA needs exact title which varies according to number of reminder items...
    Dim iReminderCount As Integer
    For iReminderCount = 1 To 25
        'Try two syntaxes...

        ReminderWindowHWnd = FindWindowA(vbNullString, iReminderCount & " Erinnerung")
        SetWindowPos ReminderWindowHWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
        BringWindowToTop (ReminderWindowHWnd)
        SetForegroundWindow ReminderWindowHWnd
        SetFocus ReminderWindowHWnd

        ReminderWindowHWnd = FindWindowA(vbNullString, iReminderCount & " Erinnerung(en)")
        SetWindowPos ReminderWindowHWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
        BringWindowToTop ReminderWindowHWnd
        SetForegroundWindow ReminderWindowHWnd
        SetFocus ReminderWindowHWnd
    Next
Exit Sub
err:
    Debug.Print err.Number & " - " & err.Description & " (iReminderCount = " & iReminderCount & ")"
    Resume Next
End Sub

Я добавил немецкие заголовки окон , а также некоторые новые функции ( BringWindowToTop, SetForegroundWindowи SetFocus).

Работает на моем немецком Windows 10 вместе с Outlook 2016.

Мне не удалось сгенерировать новый сертификат (нажатие кнопки «Пуск» и ввод «сертификата» ничего не показало), но я просто выбрал другой сертификат в списке при подписании.