Dim excApp As Excel.Application
        Err.Number = 0
 
        On Error Resume Next
        excApp = GetObject(, "Excel.Application")
 
        If Err.Number = 0 Then
 
            MsgBox("Applikation läuft bereits")
            excApp.ActiveWorkbook.Close(SaveChanges:=False)
            excApp.Quit()
            excApp = Nothing
            Exit Sub
 
        End If
 
        excApp = CreateObject("Excel.Application")
        excApp.Visible = True
        excApp = Nothing