Excel Tabelle in Access Datenbank

Sub ImportCurrentExcelData()
    ' Konstanten definieren  
    'Pfad in dem die Excel-Dateien liegen  
    Const PATH = "C:\Daten\SAP"  
    'Name der Tabelle in das die Daten importiert werden (vorhandene Daten werden vorher gelöscht)  
    Const TABLENAME = "MyExcelData"  
    
    'Variablen und Objekte initialisieren  
    Dim strCurrentSheet As String, def As TableDef
    Set fso = CreateObject("Scripting.FileSystemObject")  
    'Warnungen abschalten  
    DoCmd.SetWarnings False
    ' Pfad für aktuelle Excel-Datei zusammensetzen (Dateinameformat DD.MM.YYYY.xlsx)  
    strCurrentSheet = PATH & "\" & Format(Date, "dd.mm.yyyy") & ".xlsx"  
    'Wenn Datei exisitiert ...  
    If fso.FileExists(strCurrentSheet) Then
        'Prüfe ob Tabelle vorhanden ist, wenn ja lösche den Inhalt  
        For Each def In CurrentDb.TableDefs
            If LCase(def.Name) = LCase(TABLENAME) Then
                DoCmd.RunSQL "DELETE FROM " & TABLENAME  
                Exit For
            End If
        Next
        ' Starte dem Import der Daten (in diesem Fall haben die Spalten in der ersten Zeile Überschriften)  
        DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12, TABLENAME, strCurrentSheet, True
    Else
        ' Ein Sheet mit aktuellem Datum existiert nicht  
        MsgBox "Ein Sheet mit dem aktuellen Datum existiert nicht", vbCritical  
    End If
    'Warnunen wieder einschalten  
    DoCmd.SetWarnings True
End Sub