' Im Modul DieseOutlookSitzung (ThisOutlookSession)
 
Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
  Call MN.neue_mail(EntryIDCollection)
  GL.close_XL   ' Excel speichern und schließen
End Sub
 
Private Sub Application_Startup()
  Dim Oi As Object
  Dim Of As Object
  Dim c As Long     ' Zähler für ungelesene Mails
 
  ' Für jedes Postfach
  For Each Of In Outlook.Session.Folders
    ' Fehler Pop-Up wird unterdrückt
    On Error Resume Next
    c = Of.Folders("Inbox").UnReadItemCount
    ' -> Führt zum Fehler, wenn der Mailserver nicht erreicht wird
    If Err.Number = 0 Then  ' es liegt kein Fehler vor
      On Error GoTo 0   ' Fehler Pop-Up wird re-aktiviert
      ' Für jede Mail im Ordner Inbox
      For Each Oi In Of.Folders("Inbox").Items
        If Oi.UnRead Then
          If TypeName(Oi) = "MailItem" Then
            MN.neue_mail Oi.EntryID
          End If
          c = c - 1
          If c = 0 Then Exit For
        End If
      Next Oi
    End If
  Next Of
  ' Fehler Pop-Up wird re-aktiviert
  On Error GoTo 0
 
  ' Excel speichern und schließen
  GL.close_XL
End Sub
 
Private Sub Application_Quit()
  GL.close_XL   ' Excel speichern und schließen
  If Not NS Is Nothing Then Set NS = Nothing
End Sub

Option Explicit
 
Global NS As Outlook.NameSpace
Global Stmp As String           ' * allgemeine Variable für Texte
Global XL As Excel.Application
Global XW As Excel.Workbook
Global XS As Excel.Worksheet
 
Sub set_namespace()
  Set NS = Outlook.GetNamespace("MAPI")
End Sub
 
Sub set_XL()
  On Error Resume Next
  Set XL = GetObject(, "Excel.Application")
  If XL Is Nothing Then
    Set XL = CreateObject("Excel.Application")
  End If
  On Error GoTo 0
End Sub
 
Sub close_XL()
  If Not XS Is Nothing Then
    Set XS = Nothing
    If Not XW Is Nothing And XW.FullName = "c:\test\Wolle\Beispiel.xls" Then
      XW.Close True     ' speichern + schließen der Datei Beispiel.xls
    End If
    For Each XW In XL.Workbooks     ' prüfen, ob es versteckte Workbooks gibt
      If XL.Windows(XW.Name).Visible Then Exit For
    Next XW
    If XW Is Nothing Then   ' Es gibt keine sichtbaren Workbooks
      For Each XW In XL.Workbooks
        XW.Close True   ' speichern + schließen der versteckten Workbooks
      Next XW
      XL.Quit   ' Beenden von Excel
      Set XL = Nothing
    End If
  End If
End Sub