' <DieseOutlookSitzung>
Option Explicit

' Referenz zum Empfangen von Ereignissen der Inspectors Collection
Private WithEvents m_Inspectors As Outlook.Inspectors

' Hält Verweise auf alle cInspector Objekte
Private m_CollInsp As VBA.Collection

Private m_lNextKey As Long

Private Sub Application_Startup()
  Set m_Inspectors = Application.Inspectors
  Set m_CollInsp = New VBA.Collection
End Sub

Private Sub m_Inspectors_NewInspector(ByVal Inspector As Outlook.Inspector)
  On Error Resume Next
  Dim oInspector As cInspector

  Set oInspector = New cInspector
  If oInspector.Init(Inspector, CStr(m_lNextKey)) Then
    m_CollInsp.Add oInspector, CStr(m_lNextKey)
    m_lNextKey = m_lNextKey + 1
  End If
End Sub

Friend Property Get CollInsp() As VBA.Collection
  Set CollInsp = m_CollInsp
End Property
' </DieseOutlookSitzung>

' <cInspector.cls>
Option Explicit

' Referenz zum Empfangen von Ereignissen des Inspector Objekts
Private WithEvents m_oInspector As Outlook.Inspector

' Referenz zum Empfangen von Ereignissen des MailItem Objekts
Private WithEvents m_oItem As Outlook.MailItem

' Variables für den Objektstatus
Private m_FirstRun As Boolean
Private m_BarCreated As Boolean
Private m_IsClosed As Boolean
Private m_sKey As String

Private Sub Class_Initialize()
  m_FirstRun = True
End Sub

Private Sub Class_Terminate()
  CloseInspector
End Sub

Friend Sub CloseInspector()
  On Error Resume Next

  If m_IsClosed = False Then
    m_IsClosed = True

    RemoveCommandBar

    ' Objekt aus der Collection entfernen
    DieseOutlookSitzung.CollInsp.Remove m_sKey

    Set m_oItem = Nothing
    Set m_oInspector = Nothing
  End If
End Sub

Private Sub CreateCommandBar()
  If m_BarCreated = False Then
    ' Ergänzen: Commandbar erstellen

    m_BarCreated = True
  End If
End Sub

Private Function GetOutlookVersion() As Long
  Select Case left$(Application.Version, 2)
  Case "9.": GetOutlookVersion = 9
  Case "10": GetOutlookVersion = 10
  Case "11": GetOutlookVersion = 11
  Case "12": GetOutlookVersion = 12
  Case Else: GetOutlookVersion = 0
  End Select
End Function

Friend Function Init(oInspector As Outlook.Inspector, _
  sKey As String _
) As Boolean
  Dim obj As Object

  If Not oInspector Is Nothing Then
    Set obj = oInspector.CurrentItem

    If TypeOf obj Is Outlook.MailItem Then
      Set m_oItem = obj
      Set m_oInspector = oInspector

      m_sKey = sKey
      Init = True

      If oInspector.IsWordMail = False Then
        CreateCommandBar
      End If
    End If
  End If
End Function

Private Sub m_oInspector_Activate()
  On Error Resume Next

  If m_FirstRun Then
    m_FirstRun = False
    CreateCommandBar
  End If
End Sub

Private Sub m_oInspector_Close()
  CloseInspector
End Sub

Private Sub m_oItem_BeforeDelete(ByVal Item As Object, Cancel As Boolean)
  On Error Resume Next
  ' Dieses Ereignis gab es vor OL XP nicht.
  ' Das Ereignis wird gefeuert, nachdem der User evt.
  ' über den Speichern-Dialog hätte abbrechen können.
  ' D.h., wenn dieses Ereignis gefeuert wird, dann
  ' wird das Item auch geschlossen.
  CloseInspector
End Sub

Private Sub m_oItem_Close(Cancel As Boolean)
  On Error Resume Next

  ' @8: Drei Möglichkeiten, ein Item zu schließen:
  ' 1. Schliessen
  ' 2. Senden
  ' 3. Löschen
  ' #1 und #3 sind problemlos, wenn das Item unverändert ist.

  ' Aus Word heraus wird zuerst Inspector_Close gefeuert;
  ' dort wird da Aufräumen initialisiert. Aus OL heraus wird erst
  ' Item_Close gefeuert; auch dort kann gleich aufgeräumt werden.

  ' Wenn das Item dagegen verändert wurde, dann kann der User über den
  ' aufkommenden Speichern-Dialog die Aktion noch abbrechen.

  ' #1 feuert zuerst Item_Close, zeigt dann den Dialog. Da abgebrochen
  ' werden kann, soll in Item_Close noch nicht aufgeräumt werden.
  ' Das wird über Item.Saved geprüft.

  ' #3 zeigt erst den Dialog. Löschen JA feuert dann BeforeDelete,
  ' dann Item_Close, während Löschen NEIN nichts feuert.

  ' Das Problem ist nun OL2k: Hier gibt es das BeforeDelete-Ereignis
  ' noch nicht. In OL2k kann deswegen nciht erkannt werden, wenn ein
  ' geändertes Item direkt gelöscht wird. Das feuert zwar Item_Close,
  ' aber dann ist Saved=False, was wiederum dazu benutz werden muss,
  ' eben nicht aufzuräumen.

  If GetOutlookVersion < 10 Then
    CloseInspector
  Else
    If m_oItem.Saved Then
      CloseInspector
    End If
  End If
End Sub

Private Sub m_oItem_Send(Cancel As Boolean)
  On Error Resume Next
  CloseInspector
End Sub

Friend Sub RemoveCommandBar()
  If m_BarCreated Then
    ' Ergänzen: Commandbar entfernen

    m_BarCreated = False
  End If
End Sub
' </cInspector.cls>