Nach bestimmten Dateiendungen in Ordner (incl. aller Unterordner) suchen, zählen nach Dateiendung und jeweils Gesamtgröße ermitteln
Hallo Alle
Ich habe ein Script hier welches mir alle Dateinamen und den Pfad aus einem vorher frei auswählbaren Ordner (incl. aller Unterordner) in eine Textdatei schreibt.
Dies funktioniert soweit sehr gut.
Nun möchte ich mein Script erweitern, damit am Ende der Textdatei noch jweils die Anzahl der gefunden Dateien mit einer bestimmten Datei-Endung + die jeweile Gesamtgröße ausgegeben werden.
z.B.
Es wurden 300 Dateien mit der Endung "DOC" gefunden mit einer Gesamtgröße von 200 MB.
Es wurden 10 Dateien mit der Endung "XLS" gefunden mit einer Gesamtgröße von 20 MB.
Es sollte dann noch die Gesamtanzahl + Gesamtgröße aller Dateien mit bestimmten Endungen ausgegeben werden.
Danach sollte noch die Gesamtzahl + Gesamtgröße aller Dateien im vorher ausgewählten Ordner (incl. aller Unterordner) ausgegeben werden, unabhängig von der Datei-Endung.
Hier mal den Code, den ich bisher habe.
Leider zählt er mir die Dateien der Ordner und Unterordner nicht zusammen.
Danke für die Hilfe.
Gruß
cbli
Ich habe ein Script hier welches mir alle Dateinamen und den Pfad aus einem vorher frei auswählbaren Ordner (incl. aller Unterordner) in eine Textdatei schreibt.
Dies funktioniert soweit sehr gut.
Nun möchte ich mein Script erweitern, damit am Ende der Textdatei noch jweils die Anzahl der gefunden Dateien mit einer bestimmten Datei-Endung + die jeweile Gesamtgröße ausgegeben werden.
z.B.
Es wurden 300 Dateien mit der Endung "DOC" gefunden mit einer Gesamtgröße von 200 MB.
Es wurden 10 Dateien mit der Endung "XLS" gefunden mit einer Gesamtgröße von 20 MB.
Es sollte dann noch die Gesamtanzahl + Gesamtgröße aller Dateien mit bestimmten Endungen ausgegeben werden.
Danach sollte noch die Gesamtzahl + Gesamtgröße aller Dateien im vorher ausgewählten Ordner (incl. aller Unterordner) ausgegeben werden, unabhängig von der Datei-Endung.
Hier mal den Code, den ich bisher habe.
Leider zählt er mir die Dateien der Ordner und Unterordner nicht zusammen.
Danke für die Hilfe.
Gruß
cbli
Dim fso, fsob, listenname, frage
Set bffShell = CreateObject("Shell.Application")
Set bff = bffShell.BrowseForFolder(0,"Wählen Sie einen Ordner aus dessen Inhalt sie in eine Textdatei speichern wollen...",&H200,&H40)
If bff Is Nothing Then
wscript.quit
Else
zielfolder = bff.Items.Item.Path & "\"
end if
Set fso = CreateObject("Scripting.FilesystemObject")
Set Liste = fso.OpenTextFile("Liste.txt", 2, True)
SkriptPfad = zielfolder
DoFolders fso.GetFolder(skriptPfad)
Liste.Close
msgbox "Die Textdatei wurde erfolgreich erstellt !" ,64,"Info"
Sub DoFolders(Folder)
If LCase(Folder.Name) <> LCase("System Volume Information") Then
For Each File In Folder.Files
Liste.WriteLine File.Path
if "doc" = right(file.name, 3) Then
docgr = docgr + File.Size ' Dateigröße ermitteln
cdoc=cdoc +1 ' Dateien zählen
end if
if "xls" = right(file.name, 3) Then
xlsgr = xlsgr + File.Size ' Dateigröße ermitteln
cxls=cxls +1 ' Dateien zählen
end if
if "ppt" = right(file.name, 3) Then
pptgr = pptgr + File.Size ' Dateigröße ermitteln
cppt=cppt +1 ' Dateien zählen
end if
Next
For Each SubFolder In Folder.SubFolders
Liste.WriteLine SubFolder.Path
DoFolders(SubFolder)
Next
End If
End Sub
frage = msgbox("Möchten Sie selber einen Listennamen vergeben ?",32 + vbYesNo,"Frage")
Select Case frage
Case vbyes
listenname = InputBox("Geben Sie einen Namen für die Liste ein")
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile "Liste.txt","d:\" & listenname & " " & date & ".txt", True
set fso = nothing
Case vbno
Set fso = CreateObject("Scripting.FileSystemObject")
fso.CopyFile "Liste.txt","d:\" & "Dateiliste" & " " & date & ".txt", True
set fso = nothing
end select
Set fsob = CreateObject("Scripting.FileSystemObject")
Set bootFile = fsob.GetFile("Liste.txt")
fsob.DeleteFile bootFile, True
Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 277565
Url: https://administrator.de/contentid/277565
Ausgedruckt am: 17.11.2024 um 07:11 Uhr
7 Kommentare
Neuester Kommentar
Hallo cbli!
Du hast zwar brav damit begonnen, Variablen zu deklarieren (was in VBS grundsätzlich nicht nötig wäre), aber diejenigen, für die es tatsächlich notwendig ist (damit sie beim Unterprogrammaufruf bereits vorhanden sind), nicht in der Liste stehen: docgr, cdoc, ...
Ein
Grüße
bastla
Du hast zwar brav damit begonnen, Variablen zu deklarieren (was in VBS grundsätzlich nicht nötig wäre), aber diejenigen, für die es tatsächlich notwendig ist (damit sie beim Unterprogrammaufruf bereits vorhanden sind), nicht in der Liste stehen: docgr, cdoc, ...
Ein
Option Explicit
in Zeile 1 hätte dafür gesorgt, dass Du keine der Variablen vergisst.Grüße
bastla
Hallo cbli!
Mit der folgenden Version sollten alle Dateitypen erfasst werden (allerdings ohne Sortierung):
Grüße
bastla
Mit der folgenden Version sollten alle Dateitypen erfasst werden (allerdings ohne Sortierung):
Set fso = CreateObject("Scripting.FileSystemObject")
Set bffShell = CreateObject("Shell.Application")
Set bff = bffShell.BrowseForFolder(0,"Wählen Sie einen Ordner aus dessen Inhalt sie in eine Textdatei speichern wollen...",&H200,&H40)
If bff Is Nothing Then
Wscript.Quit
Else
zielfolder = bff.Items.Item.Path & "\"
End If
' Dictionary für Dateitypen
Set d = CreateObject("Scripting.Dictionary")
Set Liste = fso.OpenTextFile("Liste.txt", 2, True)
SkriptPfad = zielfolder
DoFolders fso.GetFolder(skriptPfad)
Liste.WriteLine
FCount = 0: FSize = 0
Result = "Zusammenfassung:"
For Each Typ In d.Keys 'Alle Dateitypen aus Dictionary auslesen, ...
V = Split(d.Item(Typ), "#") '... die zugehörigen Werte holen und ...
'... formatiert der Ausgabevariablen hinzufügen
Result = Result & vbNewLine & "Vom Typ """ & Typ & """ wurde(n) " & V(0) & " Datei(en) mit " & FormatBySize(V(1)) & " gefunden."
FCount = FCount + V(0) 'Gesamtanzahl hochzählen
FSize = FSize + V(1) 'Gesmtgröße aufaddieren
Next
'Gesamtwerte der Ausgabevariablen formatiert hinzufügen
Result = Result & vbNewline & vbNewline & "Es wurden insgesamt " & FCount & " Datei(en) mit " & FormatBySize(FSize) & " gefunden."
WScript.Echo Result 'Kontrollausgabe
Liste.Write Result 'Ausgabe Zusammenfassung in Datei
Liste.Close
Msgbox "Die Textdatei wurde erfolgreich erstellt !" ,64,"Info"
Sub DoFolders(Folder)
If LCase(Folder.Name) <> LCase("System Volume Information") Then
For Each File In Folder.Files
Liste.WriteLine File.Path
Typ = LCase(fso.GetExtensionName(File.Name)) 'Dateityp ermitteln
If d.Exists(Typ) Then 'Typ bereits in Dictionary
V = Split(d.Item(Typ), "#") 'Werte einlesen, ...
V(0) = V(0) + 1 '... Anzahl erhöhen und ...
V(1) = V(1) + File.Size '... Dateigröße aufsummieren sowie ...
d.Item(Typ) = Join(V, "#") '... wieder zurückschreiben
Else 'Typ noch nicht im Dictionary
d.Add Typ, "1#" & File.Size 'Typ mit Werten der ersten Datei in Dictionary eintragen
End If
Next
Liste.WriteLine "=============================================================================="
For Each SubFolder In Folder.SubFolders
Liste.WriteLine SubFolder.Path
DoFolders(SubFolder)
Next
End If
End Sub
frage = Msgbox("Möchten Sie selber einen Listennamen vergeben ?",32 + vbYesNo,"Frage")
Select Case frage
Case vbYes
listenname = InputBox("Geben Sie einen Namen für die Liste ein")
fso.CopyFile "Liste.txt","d:\" & listenname & " " & date & ".txt", True
Case vbNo
fso.CopyFile "Liste.txt","d:\" & "Dateiliste" & " " & date & ".txt", True
End Select
Set bootFile = fso.GetFile("Liste.txt")
fso.DeleteFile bootFile, True
Function FormatBySize(Bytes)
If Bytes < 1024 Then
FormatBySize = Bytes & " B"
ElseIf Bytes < 1048576 Then
FormatBySize = FormatNumber(Round(Bytes/1024, 2), 2) & " KB"
ElseIf Bytes < 1043741824 Then
FormatBySize = FormatNumber(Round(Bytes/1024/1024, 2), 2) & " MB"
ElseIf Bytes < 8796093022208 Then
FormatBySize = FormatNumber(Round(Bytes/1024/1024/1024, 2), 2) & " GB"
Else
FormatBySize = FormatNumber(Round(Bytes/1024/1024/1024/1024, 2), 2) & " TB"
End If
End Function
bastla
Hallo cbli!
Dictionary vorbelegen (und
Grüße
bastla
Dictionary vorbelegen (und
Else
-Zweig weglassen) wäre eine Möglichkeit; alternativ dazu:Set fso = CreateObject("Scripting.FileSystemObject")
Set bffShell = CreateObject("Shell.Application")
Set bff = bffShell.BrowseForFolder(0,"Wählen Sie einen Ordner aus dessen Inhalt sie in eine Textdatei speichern wollen...",&H200,&H40)
If bff Is Nothing Then
Wscript.Quit
Else
zielfolder = bff.Items.Item.Path & "\"
End If
Typen = ":avi:mpg:mpeg:wmv:mov:mp4:iso:mkv:m2ts:ts:idx:sub:rmvb:srt:"
' Dictionary für Dateitypen
Set d = CreateObject("Scripting.Dictionary")
Set Liste = fso.OpenTextFile("Liste.txt", 2, True)
SkriptPfad = zielfolder
DoFolders fso.GetFolder(SkriptPfad)
Liste.WriteLine
FCount = 0: FSize = 0
Result = "Zusammenfassung:"
For Each Typ In d.Keys 'Alle Dateitypen aus Dictionary auslesen, ...
V = Split(d.Item(Typ), "#") '... die zugehörigen Werte holen und ...
'... formatiert der Ausgabevariablen hinzufügen
Result = Result & vbNewLine & "Vom Typ """ & Typ & """ wurde(n) " & V(0) & " Datei(en) mit " & FormatBySize(V(1)) & " gefunden."
FCount = FCount + V(0) 'Gesamtanzahl hochzählen
FSize = FSize + V(1) 'Gesmtgröße aufaddieren
Next
'Gesamtwerte der Ausgabevariablen formatiert hinzufügen
Result = Result & vbNewline & vbNewline & "Es wurden insgesamt " & FCount & " Datei(en) mit " & FormatBySize(FSize) & " gefunden."
WScript.Echo Result 'Kontrollausgabe
Liste.Write Result 'Ausgabe Zusammenfassung in Datei
Liste.Close
Msgbox "Die Textdatei wurde erfolgreich erstellt !" ,64,"Info"
Sub DoFolders(Folder)
If LCase(Folder.Name) <> LCase("System Volume Information") Then
For Each File In Folder.Files
Liste.WriteLine File.Path
Typ = LCase(fso.GetExtensionName(File.Name)) 'Dateityp ermitteln
If InStr(Typen, ":" & Typ & ":") > 0 Then 'nur gewünschte Typen berücksichtigen
If d.Exists(Typ) Then 'Typ bereits in Dictionary
V = Split(d.Item(Typ), "#") 'Werte einlesen, ...
V(0) = V(0) + 1 '... Anzahl erhöhen und ...
V(1) = V(1) + File.Size '... Dateigröße aufsummieren sowie ...
d.Item(Typ) = Join(V, "#") '... wieder zurückschreiben
Else 'Typ noch nicht im Dictionary
d.Add Typ, "1#" & File.Size 'Typ mit Werten der ersten Datei in Dictionary eintragen
End If
End If
Next
Liste.WriteLine "=============================================================================="
For Each SubFolder In Folder.SubFolders
Liste.WriteLine SubFolder.Path
DoFolders(SubFolder)
Next
End If
End Sub
frage = Msgbox("Möchten Sie selber einen Listennamen vergeben ?",32 + vbYesNo,"Frage")
Select Case frage
Case vbYes
listenname = InputBox("Geben Sie einen Namen für die Liste ein")
fso.CopyFile "Liste.txt","d:\" & listenname & " " & date & ".txt", True
Case vbNo
fso.CopyFile "Liste.txt","d:\" & "Dateiliste" & " " & date & ".txt", True
End Select
Set bootFile = fso.GetFile("Liste.txt")
fso.DeleteFile bootFile, True
Function FormatBySize(Bytes)
If Bytes < 1024 Then
FormatBySize = Bytes & " B"
ElseIf Bytes < 1048576 Then
FormatBySize = FormatNumber(Round(Bytes/1024, 2), 2) & " KB"
ElseIf Bytes < 1043741824 Then
FormatBySize = FormatNumber(Round(Bytes/1024/1024, 2), 2) & " MB"
ElseIf Bytes < 8796093022208 Then
FormatBySize = FormatNumber(Round(Bytes/1024/1024/1024, 2), 2) & " GB"
Else
FormatBySize = FormatNumber(Round(Bytes/1024/1024/1024/1024, 2), 2) & " TB"
End If
End Function
bastla