Excel Instanz wird nicht beendet

Option Compare Database

Sub Import(Path As String, Tabelle As String, ByRef Datum As Date)
On Error GoTo Err_Handler
    Dim app As Excel.Application
    Dim wbk As Excel.Workbook
    Dim wks As Excel.Worksheet
    Dim rsKat As DAO.Recordset
    Dim rsCode As DAO.Recordset
    Dim rsTabelle As DAO.Recordset
    Dim zeile As Integer
    Dim zSumme As Long ' Zeilen summe, wenn diese 0 ist kommt immer eine neue Kategorie  
       

    'Warnmeldung ausschalten  
    DoCmd.SetWarnings False
    
    'Prüfen das der Pfad nicht leer ist  
    If Path <> "" Then  
    
        'Sanduhr  
        DoCmd.Hourglass True
        
        'Excel öffnen  
        Set app = New Excel.Application
        Set wbk = app.Workbooks.Open(Path)
        Set wks = wbk.Worksheets("Sheet1")  
        
        'Recordsets init  
        Set rsKat = CurrentDb.OpenRecordset("Kategorie", dbOpenDynaset)  
        Set rsCode = CurrentDb.OpenRecordset("Code", dbOpenDynaset)  
        Set rsTabelle = CurrentDb.OpenRecordset(Tabelle, dbOpenDynaset)
        zSumme = 0
        
        'Anzahl der Spalten bestimmen  
        Select Case Tabelle
            Case "Anfragen"  
                Spalten = 27
            Case "CBDaten"  
                Spalten = 20
            Case "Kunde"  
                Spalten = 27
        End Select
                
        'Zielen durchlaufen und in die Datenbank schreiben  
        zeile = 3
        Do While wks.Cells(zeile, 1) <> "Summe Fachteams"  
            'K_ID heraussuchen  
            If zSumme = 0 Then
                'Prüfen ob es diese Kategorie schon gibt  
                Lookup = DLookup("K_ID", "Kategorie", "Kategorie Like '" & wks.Cells(zeile, 1) & "'")  
                If Lookup > 0 Then
                    K_ID = Lookup
                Else
                    'Neue Kategorie anlegen  
                    With rsKat
                        .AddNew
                        !Kategorie = wks.Cells(zeile, 1)
                        K_ID = !K_ID
                        wbk.Update
                    End With
                End If
                
                zSumme = Zeilensumme(wks, zeile)
            Else
                zSumme = zSumme - Zeilensumme(wks, zeile)
                
                'Codegruppe ermitteln  
                 Lookup = DLookup("C_ID", "Code", "K_ID = " & K_ID & " AND Code Like '" & wks.Cells(zeile, 1) & "'")  
                'Prüfen ob der Code schon vorhanden ist, sonst anlegen  
                If Lookup > 0 Then
                    C_ID = Lookup
                Else
                    With rsCode
                    .AddNew
                    !K_ID = K_ID
                    !Code = wks.Cells(zeile, 1)
                    C_ID = !C_ID
                    .Update
                    End With
                End If
                
                'Anfragendaten einfügen  
                With rsTabelle
                    .AddNew
                    !Monat = Datum
                    !C_ID = C_ID
                    For i = 2 To Spalten
                       .Fields(i) = wks.Cells(zeile, i)
                    Next i
                    .Update
                End With
             End If
             
            zeile = zeile + 1
        Loop
        
        'Aufräumen  
        rsKat.Close
        Set rsKat = Nothing
        rsCode.Close
        Set rsCode = Nothing
        rsTabelle.Close
        Set rsTabelle = Nothing
        'Sanduhr  
        DoCmd.Hourglass False
        
    End If 
    
    'Wanrmeldungen wieder anschaltenen, man weiß ja nie  
    DoCmd.SetWarnings True
Exit_Err_Handler:
    Exit Sub
    
Err_Handler:

    MsgBox "Es konnten Zeilen nicht importiert werden. Ist die Datei vielleicht schon Importiert?(" + Err.Description + " " + Err.Source + ")"  

    
    DoCmd.Hourglass False
    Resume Exit_Err_Handler:

End Sub
' Berechnet aus einer Zeile eine Zeilensumme  
Function Zeilensumme(wks As Excel.Worksheet, zeile As Integer) As Long
    'Es ist ausreichend nur die Spalte Rückfragen ohne Gesrpäche und Rufzeit zu addieren, da ich noch keine Zeile gefunden habe  
    'wo alle 3 Spalten null sind. Sollte das irgendwann einmal auftrauchen muss hier dann noch eine weiter Spalte mit eingerechnet werden  
    'Für Den CB noch die Spalte 15 die nie Null ist  
    Zeilensumme = wks.Cells(zeile, 10) _
                + wks.Cells(zeile, 11) _
                + wks.Cells(zeile, 15) _
                + wks.Cells(zeile, 16)
                
End Function