Outlook: Makro: Infofenster für Terminerinnerungen einblenden

Gelegentlich kommt es vor, das eine Erinnerung an einen Kalendertermin nicht im Vordergrund dargestellt wird. Mit diesem Makro in VBA wird ein kleines, zusätzliches Popup generiert, das immer zu sehen ist.

1. Outlook Alt + F11 Schlüssel zum Öffnen des Microsoft Visual Basic für Applikationen Fensters.
2. Dort Doppelklicken Sie auf das Fenster ThisOutLookSession im linken Fensterbereich, um das Codefenster zu öffnen.
   

   

   
   
3. Dort diesen Code einfügen:

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 Resume Next
Dim xAppointment As AppointmentItem
If Item.Class = olAppointment Then
    Set xAppointment = Item
    MsgBox xAppointment.Organizer + ": " + xAppointment.Subject + " um  " + Format(xAppointment.Start, "hh:mm") + vbCrLf + xAppointment.Location, 4096 + vbInformation + vbOKOnly, "Outlook Errinnerung"
End If
On Error GoTo err
Dim iReminderCount As Integer
ReminderWindowHWnd = FindWindowA(vbNullString, iReminderCount & " Erinnerung")
For iReminderCount = 1 To 32
  If ReminderWindowHWnd > 0 Then
   SetWindowPos ReminderWindowHWnd, HWND_TOPMOST, 0, 0, 0, 0, FLAGS
   BringWindowToTop ReminderWindowHWnd
   SetForegroundWindow ReminderWindowHWnd
   SetFocus ReminderWindowHWnd
   Exit For
  End If
  ReminderWindowHWnd = FindWindowA(vbNullString, iReminderCount & " Erinnerung(en)")
Next
Exit Sub
err:
Debug.Print err.Number & " - " & err.Description & " (iReminderCount = " & iReminderCount & ")"
Resume Next
End Sub