# Ordner, Unterordner und Dateien löschen per VBS



## Supe (3. März 2010)

Hallo Leute!

Meine Stärken liegen im Bereich Grafikbearbeitung und 3D, sicherlich nicht bei VBS und Scripting. 
Als "spezielle Sonderaufgabe" meines Chefs für unseren Dateiserver (Win2K3 R2, als Admin) habe ich nun die Löschung eines Verzeichnisses, egal welchen Inhalts (Unterordner, Dtaeien, schreibgeschützte Dateien) auf's Auge gedrückt bekommen.

Ich habe nicht soviel Zeit für die Extrawürste meines Chefs neben meiner normalen Arbeit, deshalb hier meine Frage, wer mir schnell und kompetent ("Mach es so!") helfen kann. Ich kann jetzt nicht einen VBS-Kurs machen, weshalb mir RTFM-Antworten wenig weiter helfen.

Augabenstellung: Jeden Nacht (Task-Planer) um 0.00 Uhr sollen alle Dateien und Ordner, Unterordner und Dateien darin im Stamm-Ordner D:\Allgemeine Ablage\Datentausch  und D:\Allgemeine Ablage\Scandokumente ungefragt gelöscht werden. Egal ob mit Schreibschutz oder nicht.

Nachdem ich mit DOS rumgefuhrwerkt habe, bin ich über Google auf ein VBS-Script gestoßen:


```
Option Explicit
dim fso, strPfad

strPfad = "D:\Allgemeine Ablage\Datentausch"

Set fso = CreateObject("Scripting.FileSystemObject")

DeleteFiles strPfad

fso.DeleteFolder ("D:\Allgemeine Ablage\Datentausch\*")

Sub DeleteFiles(strFolder)
 dim oFolder, oFolders, oFiles, item

 On Error Resume Next

 Set oFolder = fso.GetFolder(strFolder)
 Set oFolders = oFolder.SubFolders
 Set oFiles = oFolder.Files

 For each item in oFolders
  DeleteFiles(item)
 Next

 For each item in oFiles
  ' um Schreibgeschützte Dateien zu löschen, True übergeben
  fso.DeleteFile item, True
 Next
End Sub
```

Das klappt soweit, aber sobald ich den zweiten Ordner hinzufüge ...


```
Option Explicit
dim fso, strPfad

strPfad = "D:\Allgemeine Ablage\Datentausch"
strPfad = "D:\Allgemeine Ablage\Scandokumente"

Set fso = CreateObject("Scripting.FileSystemObject")

DeleteFiles strPfad

fso.DeleteFolder ("D:\Allgemeine Ablage\Datentausch\*")
fso.DeleteFolder ("D:\Allgemeine Ablage\Scandokumente\*")

Sub DeleteFiles(strFolder)
 dim oFolder, oFolders, oFiles, item

 On Error Resume Next

 Set oFolder = fso.GetFolder(strFolder)
 Set oFolders = oFolder.SubFolders
 Set oFiles = oFolder.Files

 For each item in oFolders
  DeleteFiles(item)
 Next

 For each item in oFiles
  ' um Schreibgeschützte Dateien zu löschen, True übergeben
  fso.DeleteFile item, True
 Next
End Sub
```


... werden unter Datentausch keinerlei Datein oder Ordner mehr gelöscht. Sicherlich mache ich da etwas falsch, aber so sehr ich mich diletanisch auch versuche, ich kriege das nicht hin. Für Euch VBS-Experten sicherlich Kleinkram.

Wer kann mir hier weiterhelfen?
Danke vorab für Eure Unterstützung!
Supe


----------



## Yaslaw (8. März 2010)

```
strPfad = "D:\Allgemeine Ablage\Datentausch"
strPfad = "D:\Allgemeine Ablage\Scandokumente"
```
Du überscrheibst da den Pfad. Es wird nur der 2te genommen.


----------



## Supe (9. März 2010)

Okay, danke für den Hinweis. Da ich nicht sehr bewandert bin: Wie erreiche ich eine serielle Abarbeitung der Verzeichnisse; der Dateien darin?

Danke für eine Antwort!
Supe


----------



## Yaslaw (9. März 2010)

Schreib deine Lösung in eine Funktion und rufe sie 2 mal auf....


```
Option Explicit
dim fso, strPfad

Set fso = CreateObject("Scripting.FileSystemObject")

Call deleteFolder("D:\Allgemeine Ablage\Datentausch")
Call deleteFolder("D:\Allgemeine Ablage\Scandokumente")

Sub deleteFolder(strFolder)
  Call DeleteFiles(strFolder)
  Call fso.DeleteFolder(strFolder & "\*")
End Sub

Sub DeleteFiles(strFolder)
 dim oFolder, oFolders, oFiles, item

 On Error Resume Next

 Set oFolder = fso.GetFolder(strFolder)
 Set oFolders = oFolder.SubFolders
 Set oFiles = oFolder.Files

 For each item in oFolders
  DeleteFiles(item)
 Next

 For each item in oFiles
  ' um Schreibgeschützte Dateien zu löschen, True übergeben
  fso.DeleteFile item, True
 Next
End Sub
```


----------



## Supe (10. März 2010)

Danke Dir, yaslaw! Das klappt jetzt 1a.


----------



## Supe (18. Oktober 2017)

Hallo!

Heute möchte ich diese Funktion um das Löschen von bestimmt benannten Dateien (bas*) in einem bestimmten Ordner (C:\Java\tomcat7a\conf) erweitern.
Wie baue ich das in das unten stehende Script ein?



```
Option Explicit

dim fso, strPfad

Set fso = CreateObject("Scripting.FileSystemObject")

Call deleteFolder("C:\Java\tomcat7a\temp")

Call deleteFolder("C:\Java\tomcat7a\work")

Call deleteFolder("C:\Java\tomcat7a\logs")

Sub deleteFolder(strFolder)

    Call DeleteFiles(strFolder)

    Call fso.DeleteFolder(strFolder & "\*")

End Sub

Sub DeleteFiles(strFolder)

dim oFolder, oFolders, oFiles, item

On Error Resume Next

Set oFolder = fso.GetFolder(strFolder)

Set oFolders = oFolder.SubFolders

Set oFiles = oFolder.Files

For each item in oFolders

  DeleteFiles(item)

Next

For each item in oFiles

  ' um Schreibgeschützte Dateien zu löschen, True übergeben

fso.DeleteFile item, True

Next

End Sub


Wscript.Echo "*** Daten gelöscht ***"[
```

Ich möchte also die Arbeitsverzeichnisse eines Tomcats leeren und aus dem Conf-Verzeichnis alle Dateien rauslöschen die mit "bas" anfangen.
Wie erweitere ich mein Skript geschickt an welcher Stelle?

Danke vorab für Eure Hilfestellung!
Supe


----------



## Yaslaw (23. Oktober 2017)

```
deleteFilesWithFilter("C:\Java\tomcat7a\conf", "bas*")

Sub deleteFilesWithFilter(strFolder, strFilter)
 dim oFolder, oFiles, item
 Set oFolder = fso.GetFolder(strFolder)
 Set oFiles = oFolder.Files
 For each item in oFiles
  If item.Name like strFilter Then
   ' um Schreibgeschützte Dateien zu löschen, True übergeben
   fso.DeleteFile item, True
  End If
 Next
End Sub
```


----------



## Supe (23. Oktober 2017)

Hallo Yaslaw,

danke für's Ergänzen!

Ich habe es nun so eingefügt:



```
Option Explicit
dim fso, strPfad
Set fso = CreateObject("Scripting.FileSystemObject")
Call deleteFolder("C:\Java\tomcat7a\temp")
Call deleteFolder("C:\Java\tomcat7a\work")
Call deleteFolder("C:\Java\tomcat7a\logs")
Sub deleteFolder(strFolder)
    Call DeleteFiles(strFolder)
    Call fso.DeleteFolder(strFolder & "\*")
End Sub
Sub DeleteFiles(strFolder)
dim oFolder, oFolders, oFiles, item
On Error Resume Next
Set oFolder = fso.GetFolder(strFolder)
Set oFolders = oFolder.SubFolders
Set oFiles = oFolder.Files
For each item in oFolders
  DeleteFiles(item)
Next
For each item in oFiles
  ' um Schreibgeschützte Dateien zu löschen, True übergeben
fso.DeleteFile item, True
Next
End Sub

deleteFilesWithFilter("C:\Java\tomcat7a\conf", "bas*")

Sub deleteFilesWithFilter(strFolder, strFilter)
dim oFolder, oFiles, item
Set oFolder = fso.GetFolder(strFolder)
Set oFiles = oFolder.Files

For each item in oFiles
If item.Name like strFilter Then
' um Schreibgeschützte Dateien zu löschen, True übergeben
fso.DeleteFile item, True
End If

Next
End Sub

Wscript.Echo "*** Daten gelöscht ***"
```

Bekomme dann aber die Fehlermeldung, dass in Zeile 33 (deleteFilesWithFilter("C:\Java\tomcat7a\conf", "bas*")) beim Aufrufen der Unterrputine (Sub) keine Klammern verwendet werden dürfen (Fehlercode: 800A0414).


----------



## Yaslaw (23. Oktober 2017)

Stimmt. Lass die Klammer weg

```
deleteFilesWithFilter "C:\Java\tomcat7a\conf", "bas*"
```


----------



## Supe (23. Oktober 2017)

Okay, danke, habe ich gemacht. 
Skript läuft bis Zeile 44 (If item.Name like strFilter Then) mit der Meldung Sub oder Function-Prozedur nicht definiert (800A0023).

Fehlt noch was?


----------



## Yaslaw (23. Oktober 2017)

Hm... Ich programmiere fast nie VBS sondern immer VBA. Kennt VBS den Befehl Like nicht?

Ich habe aber ein ähnliches Script. Dort arbeite ich aber mit RegExp und das funktioniert einwandfrei


```
'-------------------------------------------------------------------------------
'File         : lib_cookies
'               Copyright mpl by ERB software
'               All rights reserved
'               http://wiki.yaslaw.info/dokuwiki/doku.php/vba/
'Environment  : VBA 2007 +
'Version      : 1.0.0
'Name         :
'Author       : Stefan Erb (ERS)
'History      : 03.05.2017 - ERS - Creation
'-------------------------------------------------------------------------------
Option Explicit

'/**
' * Pfad zu den Cookies
' */
Const C_COOKIES_FOLDER = "C:\Users\XXXXXX\AppData\Roaming\Microsoft\Windows\Cookies\"
Const C_LOG_FILE = "C:\XXXX\VB_SCRIPTS\del_cookies.log"

Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
Dim logStream:   Set logStream = fso.OpenTextFile(C_LOG_FILE, 8, True)
Dim cnt

cnt = deleteCookies(C_COOKIES_FOLDER, "/tagesanzeiger/i")
logStream.writeLine now & vbTab & cnt & vbTab &  "/tagesanzeiger/i"
cnt = deleteCookies(C_COOKIES_FOLDER, "/landbote/i")
logStream.writeLine now & vbTab & cnt & vbTab &   "/landbote/i"

logStream.close
'-------------------------------------------------------------------------------
' Public members
'-------------------------------------------------------------------------------
'/**
' * Löscht alle Cookies eines Patterns. Das Cookie-Verzeichnis wird Rekursiv durchsucht. Sprich, auch die Unterverzeichnisse sind betroffen
' * @param  String      URL zu den Cookies
' * @param  String      RegExp-Pattern inkl. Modifiers -> http://wiki.yaslaw.info/doku.php/vba/cast/cregexp#pattern_inkl_modifiers
' * @return Long        Anzahl gelöschter Cookies
' */
Function deleteCookies(ByVal iPath, ByVal iPattern)
    Dim f
    Dim rxEntry: Set rxEntry = cRx(iPattern)


    Dim rxFileFilter:  Set rxFileFilter = cRx("/\.txt$/i")

    'Durch die Subfolder iterieren
    For Each f In fso.GetFolder(iPath).SubFolders
        deleteCookies = deleteCookies + deleteCookies(f.path, iPattern)
    Next
    
    'Die einzelnen Files durchgehen
    For Each f In fso.GetFolder(iPath).Files
        'sicherstellen, dass es ein Cookie ist
        If rxFileFilter.test(f.name) Then
            'Inhalt prüfen
            Dim stream
            Set stream = f.OpenAsTextStream
            if not stream.AtEndOfStream then
                If rxEntry.test(stream.ReadAll) Then
                    stream.close
                    f.delete True
                    deleteCookies = deleteCookies + 1
                End If
            end if
        End If
    Next    
End Function


'-------------------------------------------------------------------------------
' Private Libraries
'-------------------------------------------------------------------------------

' Die folgende Version cRx() verwende ich als Library in anderen Funktion.
' Sie entspricht der Version mit den Modifier im String.

'/**
' * Dies ist die Minimalversion von cRegExp
' * http://wiki.yaslaw.info/dokuwiki/doku.php/vba/cast/cregexp#abgespeckte_version
' * mögliche Delemiter: @&!/~#=\|
' * mögliche Modifiers: g (Global), i (IgnoreCode, m (Mulitline)
' *
' * @example    myRx = cRx("/([a]{2,})/i") 'Finde alle folgen von a. Flag:IgnoreCase
' * @version    2.1.0 (01.12.2014)
' * @param      String      Pattern mit Delimiter und Modifier analog zu PHP
' * @return     Object      RegExp-Object
' */
Function cRx(ByVal iPattern)
    Set cRx = CreateObject("VBScript.RegExp")
    Dim rxP: Set rxP = CreateObject("VBScript.RegExp"): rxP.pattern = "^([@&!/~#=\|])?(.*)\1(?:([Ii])|([Gg])|([Mm]))*$"
    Dim sm :           Set sm = rxP.execute(iPattern)(0).subMatches
    cRx.pattern = sm(1):        cRx.IgnoreCase = Not isEmpty(sm(2)):       cRx.Global = Not isEmpty(sm(3)):     cRx.Multiline = Not isEmpty(sm(4))
End Function
```


----------



## Supe (23. Oktober 2017)

Da bin ich - als absolute Programmierniete - völlig der falsche Ansprechpartner. Ich nutzniese hier nur.

Laut MS (https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/operators/like-operator) kennt VB den Befehl "If/LIke/Then", aber er wird mit Anführungszeichen definiert. Ist hier die Variable noch nicht korrekt eingebunden?


----------



## Yaslaw (23. Oktober 2017)

Ich sehe bei deinem Code kein Fehler


----------



## Supe (24. Oktober 2017)

Ich leider auch nicht. Gibt's vielleicht einen VBS-Experten, der mir hier weiterhelfen könnte?


----------



## Yaslaw (24. Oktober 2017)

Ein Kurzer Test hat ergeben, dass VBS keine Freude am LIKE hat. Dein Link zeigt zu VB. Nicht ales was in VB6 oder VBA funktioniert geht auch in VBS.

Du kannst entweder über RegExp gehen oder den Dateinamen zerlegen. Das ist einfacher, geht jedoch nur gut, wenn du wirklich nur den Anfang prüfen willst.

```
'Achtung: Beim Filter den * weglassen!
deleteFilesWithFilter "C:\ABC\test", "bas"

Sub deleteFilesWithFilter(strFolder, strFilter)
 dim oFolder, oFiles, item
 Set oFolder = fso.GetFolder(strFolder)
 Set oFiles = oFolder.Files
 
 For each item in oFiles
  If left(item.Name, len(strFilter)) = strFilter Then
   ' um Schreibgeschützte Dateien zu löschen, True übergeben
   fso.DeleteFile item, True
  End If
 
 Next
End Sub
```


----------



## Supe (24. Oktober 2017)

Hurra! Das tut's jetzt! Sauber! Danke Yaslaw!

Jetzt möchte ich nur nicht nur die Ordner geleert haben sondern die Ordner ganz wegschießen:


```
Set fso = CreateObject("Scripting.FileSystemObject")
Call deleteFolder("C:\Java\tomcat7a\temp")
Call deleteFolder("C:\Java\tomcat7a\work")
Call deleteFolder("C:\Java\tomcat7a\logs")
Sub deleteFolder(strFolder)
Call DeleteFiles(strFolder)
 Call fso.DeleteFolder(strFolder & "\*")
End Sub
```

Damit werden immer nur die Ornder geleert, aber "work" soll auch weg, da es neu erstellt werden soll.
Wie ist dazu der Befehl?


----------



## Yaslaw (25. Oktober 2017)

Suchs dir selber aus. Geht auch über das FileSystemObject (fso)
https://msdn.microsoft.com/de-de/library/z9ty6h50(v=vs.84).aspx


----------



## Supe (27. Oktober 2017)

Bekomme ich nicht hin. Die Ordner werden geleert, aber nicht gelöscht, egal mit welcher Methode.


----------



## Yaslaw (27. Oktober 2017)

Was soll der \* bewirken?

```
Call fso.DeleteFolder(strFolder)
```


----------

