Private Sub Workbook_Open()
    MsgBox ("Programm gestartet")
    PrüfeAufWorkbooks
End Sub
Public Sub PrüfeAufWorkbooks()
    'Variablen initialisieren
    Dim Durchzähler As Integer
    Dim DurchzählerInner As Integer
    Dim Enthalten As Boolean
    Dim AktivBook As String
    Dim M() As String 'VergleichsArray 1
    Dim M2 As Workbooks
    Dim Z() As String 'VergleichsArray 2
    'Dim Z2 As Workbooks
 
Restart:
    Set M2 = Application.Workbooks
    If M2.Count > 0 Then
        'VergleichsArray 2 initialisieren
        ReDim Z(1 To M2.Count) As String
        For Durchzähler = 1 To M2.Count
            Z(Durchzähler) = GenerateKey(M2.Item(Durchzähler))
        Next Durchzähler
    Else
        GoTo WarteAufGeöffneteWorkbooks
    End If
Start:
    Set M2 = Application.Workbooks
    If M2.Count > 0 Then
        'VergleichsArray 1 aufbauen
        ReDim M(1 To M2.Count) As String
            For Durchzähler = 1 To M2.Count
            M(Durchzähler) = GenerateKey(M2.Item(Durchzähler))
        Next Durchzähler
        DoEvents
 
        'Array auf nach neue Workbooks durchsuchen
        For Durchzähler = 1 To UBound(M)
            Enthalten = True
            AktivBook = M(Durchzähler)
            Enthalten = False
            For DurchzählerInner = 1 To UBound(Z)
                If AktivBook = Z(DurchzählerInner) Then Enthalten = True
            Next DurchzählerInner
            If Not Enthalten Then WorkbookOpen AktivBook, M2.Item(Durchzähler), _
              Durchzähler
        Next Durchzähler
 
        'Array auf geschlossene Workbooks durchsuchen
        For Durchzähler = 1 To UBound(Z)
            Enthalten = True
            AktivBook = Z(Durchzähler)
            Enthalten = False
            For DurchzählerInner = 1 To UBound(M)
                If AktivBook = M(DurchzählerInner) Then Enthalten = True
            Next DurchzählerInner
            If Not Enthalten Then WorkbookClosed AktivBook, Durchzähler
        Next Durchzähler
 
        DoEvents
        'Dem VergleichsArray 2 das VergleichsArray 1 zuweisen
        ReDim Z(1 To UBound(M)) As String
        For Durchzähler = 1 To UBound(M)
            Z(Durchzähler) = M(Durchzähler)
        Next Durchzähler
 
        'Warten und wieder von Vorne Starten
        GoSub Warte
        GoTo Start
        Exit Sub
    Else
        'Alle noch im Array befindlichen Workbooks als geschlossen definieren
        For Durchzähler = 1 To UBound(Z)
            WorkbookClosed Z(Durchzähler), Durchzähler
        Next Durchzähler
WarteAufGeöffneteWorkbooks:
        'Warten bis wieder Workbooks geöffnet werden        
        Do While Application.Workbooks.Count <= 0
            GoSub Warte
        Loop
        GoTo Restart
        Exit Sub
    End If
 
    'Warten und wieder zum Anfang
Warte:
    DoEvents
    Return
End Sub
Public Function GenerateKey(W As Workbook) As String
    GenerateKey = W.Name & "?" & W.Path
End Function
Public Function ExtractName(N As String) As String
    ExtractName = Left(N, InStr(1, N, "?", vbBinaryCompare) - 1)
End Function
 
 
Private Sub WorkbookOpen(N As String, W As Workbook, Num As Integer)
    'Hier Programm einfügen
    MsgBox ("Geöffnet wurde " & ExtractName(N))
End Sub
Private Sub WorkbookClosed(N As String, Num As Integer)
    'Hier Programm einfügen
    MsgBox ("Geschlossen wurde " & ExtractName(N))
End Sub