VBA Tipp: Datei löschen

Aus DBWiki
Wechseln zu: Navigation, Suche

Aufgabenstellung

Ich möchte eine Datei löschen.

  • Lösung 1: Eine oder mehrere Dateien löschen mit der Kill-Funktion
  • Lösung 2: Eine Datei löschen mit dem FileSystemObject
  • Lösung 3: Eine oder mehrere Dateien oder einen Ordner löschen oder in den Papierkorb verschieben mit der API-Funktion SHFileOperation

Lösung 1

Das geht mit der VBA-Funktion kill.

 'Eine Datei löschen
 On Error Resume Next
 Kill "D:\Eigene Dateien\test\test.txt"
 'Alle txt-Dateien in einem Ordner löschen
 On Error Resume Next
 Kill CurrentProject.Path & "\test\*.txt"
 'Alle Dateien in einem Ordner löschen, Unterordner werden nicht gelöscht
 On Error Resume Next
 Kill CurrentProject.Path & "\test\*.*"

Lösung 2

Das geht mit dem FileSystemObject.

 'Eine Datei löschen
 On Error Resume Next
 CreateObject("Scripting.FileSystemObject").DeleteFile CurrentProject.Path & "\test\test.txt"

Hinweis zu den Codes:

Die Anweisung On Error Resume Next sorgt dafür, daß keine Fehlermeldung angezeigt wird, wenn die Datei bereits gelöscht wurde bzw. nicht existiert.

Lösung 3

Das geht mit folgender API-Funktion und VBA-Funktion, die in einem globalen Modul hinterlegt werden.

Private Type SHFILEOPSTRUCT
  hWnd As Long
  wFunc As Long
  pFrom As String
  pTo As String
  fFlags As Integer
  fAnyOperationsAborted As Long
  hNameMappings As Long
  lpszProgressTitle As String
End Type
 
'Konstanten für wFunc
Private Const FO_DELETE As Long = &H3   ' Dateien löschen
 
'Konstanten für fFlags
Private Const FOF_NOCONFIRMATION As Long = &H10  ' Keine Bestätigungen anfordern
Private Const FOF_ALLOWUNDO As Long = &H40       ' in Papierkorb verschieben
Private Const FOF_FILESONLY As Long = &H80       ' bei WildCards *.* nur auf Dateien beziehen
 
Private Declare Function SHFileOperation Lib "shell32.dll" Alias "SHFileOperationA" ( _
                         lpFileOp As SHFILEOPSTRUCT _
                         ) As Long
 
Public Function DateiLöschen(ByVal Dateipfade As String, _
                             Optional ByVal InPapierkorb As Boolean = False, _
                             Optional ByVal MitRückfrage As Boolean = False, _
                             Optional ByVal MitUnterordnern As Boolean = False _
                             ) As Boolean
 
 'Quelle: http://www.dbwiki.net/
 
 Dim fo As SHFILEOPSTRUCT
 
 'Datei löschen
 fo.wFunc = FO_DELETE
 
 'Zeichen 0 anfügen
 fo.pFrom = Dateipfade & vbNullChar
 
 'in Papierkorb verschieben
 If InPapierkorb = True Then
   fo.fFlags = FOF_ALLOWUNDO
 End If
 
 'mit Rückfrage
 If MitRückfrage = False Then
   fo.fFlags = fo.fFlags Or FOF_NOCONFIRMATION
 End If
 
 'mit Unterordnern (bei Angabe von \*.*)
 If MitUnterordnern = False Then
   fo.fFlags = fo.fFlags Or FOF_FILESONLY
 End If
 
 DateiLöschen = Not CBool(SHFileOperation(fo))
 
End Function

Aufruf Lösung 3

  • Für die Dateinamen können Platzhalter z.B. *.* oder *.txt verwendet werden.
  • Mehrere Dateien werden, mit dem Zeichen Nr. 0 getrennt, als String zusammengefasst, nach dem Muster:
strPfad = Dateipfad1 & vbNullChar & Dateipfad2 & vbNullChar & Dateipfad3
 Dim strPfad As String
 
 'Beispiel 1: Eine Datei löschen
 strPfad = CurrentProject.Path & "\test\login.htm"
 Call DateiLöschen(strPfad)
 
 'Beispiel 2: Einen Ordner in den Papierkorb verschieben
 strPfad = CurrentProject.Path & "\test"
 Call DateiLöschen(strPfad, True)
 
 'Beispiel 3: Eine Datei in den Papierkorb verschieben, mit Rückfrage
 strPfad = CurrentProject.Path & "\test\Bedienungsanleitung.pdf"
 Call DateiLöschen(strPfad, True, True)
 
 'Beispiel 4: Zwei Dateien in den Papierkorb verschieben, ohne Rückfrage
 'Die Pfade der einzelnen Dateien werden als String addiert
 'mit dem Zeichen 0 (vbNullChar) als Trennzeichen.
 strPfad = CurrentProject.Path & "\test\Bedienungsanleitung.pdf" & vbNullChar & _
           CurrentProject.Path & "\test\Datenbank-Performance.pdf"
 Call DateiLöschen(strPfad, True)
 
 'Beispiel 5: Alle Dateien eines Ordners in den Papierkorb verschieben, ohne Rückfrage, mit Unterordnern
 Call DateiLöschen(CurrentProject.Path & "\test\*.*", True, , True)

Wiki-Links

Web-Links