Laufzeitfehler 3734 Datenbank komprimieren funktioniert nicht

 Sub DB_erstellen(Pfad As String, DBname As String)
 Dim db As DAO.Database
 Rem eine leere Access-Datenbank anlegen

 On Error GoTo Fehler
 
 Datei = Pfad & DBname
 Rem prüfen ob Datei schon vorhanden ist
 If Dir(Datei) <> "" Then  
    MsgBox "Datei ist schon vorhanden!", , _  
           "keine Änderung durchgeführt"  
 Else
   Set db = CreateDatabase(Datei, dbLangGeneral)
    Set db = Nothing
 End If

 Exit Sub

Fehler:
 Set db = Nothing
 MsgBox "FehlerNr.: " & Err.Number & vbNewLine & vbNewLine _  
        & "Beschreibung: " & Err.Description _  
        , vbCritical, "Fehler aufgetreten"  
 End Sub

Public Function fctCompactOtherDB(strPath As String)
  'Komprimiert die angegebene MDB  
  'Aufruf: fctCompactOtherDB "Pfad_und_Name_der_zu_komprimierenden.mdb"  

  On Error GoTo myError
    
  DoCmd.Hourglass True
    
  Dim strFile As String
  Dim varDummyPath As Variant
  Dim varDummyFile As Variant
    
  strFile = Dir(strPath)
  varDummyPath = Left$(strPath, Len(strPath) - Len(strFile))
  varDummyFile = varDummyPath & "Dummy.mdb"  
  DBEngine.CompactDatabase strPath, varDummyFile
  Kill strPath
  Name varDummyFile As strPath
    
myExit:
    DoCmd.Hourglass False
    Exit Function
    
myError:
    Select Case Err.Number
      Case 3005, 3024, 53, 3044, 76
        MsgBox "Die Datenbank konnte nicht gefunden werden.", vbOKOnly  
      Case 3196
        MsgBox "Die Datenbank wird zur Zeit verwendet.", vbOKOnly  
      Case Else
        MsgBox "Ausnahme Nr. " & Err.Number & ". Das heißt: " & Err.Description  
    End Select
    Resume myExit

End Function