cbli
Jul 16, 2015, updated at Jul 17, 2015 (UTC)
view3430
view7
0
Goto Top

Nach bestimmten Dateiendungen in Ordner (incl. aller Unterordner) suchen, zählen nach Dateiendung und jeweils Gesamtgröße ermitteln

GermansolvedQuestionVB for ApplicationsDevelopment
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


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
comment-contentCommentShareShare
Share on Facebook Share on Twitter Share on Reddit Share on Linkedin

Content-Key: 277565

Url: https://administrator.de/contentid/277565

Printed on: April 25, 2024 at 23:04 o'clock

7 Comments
Latest comment
Goto Top
Member: bastla
bastla Jul 16, 2015 at 19:54:14 (UTC)
Goto Top
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 Option Explicit in Zeile 1 hätte dafür gesorgt, dass Du keine der Variablen vergisst.

Grüße
bastla
Member: cbli
cbli Jul 16, 2015, updated at Jul 17, 2015 at 13:56:02 (UTC)
Goto Top
Hallo bastla!


Vielen Dank für deinen Hinweis, ich hab nach 4 Jahren Pause wieder angefangen mit VB Script zu arbeiten und wohl wieder eine Menge vergessen,
von meinem eh nur bescheidenen Wissen darüber.

Jedenfalls funktioniert mein erweitertes Script nun fast wie es sollte. 2 Dinge würde ich gerne noch umsetzen.
Ich hätte gerne in der Textdatei nach vor und nach jedem Ordnerwechsel (bei evtl. Unterordnern) eine Leerzeile eingefügt zur besseren Übersicht.

Dann wollte ich noch für die Gesamtgrößenangabe der gefilterten Dateien noch eine Größenformatierung einfügen.
Das Script sollte automatisch erkennen ob es sich um Bytes,KB, MB, GB,TB...usw handelt und die entsprechende Größenformatierung mit nur 2
Nachkommastellen in die Textdatei schreiben.

Ach ja und wie könnte ich das mit einer Schleife machen, damit ich das Ganze nicht für jede andere Dateiendung nochmal runterschreiben muss ?
In meinem Beispiel hier geht es um die Dateiendung "MOV". Insgesamt sind es momentan 10-12, kann aber auch noch mehr werden.

Hier mal meinen Ansatz der aber leider nicht funktioniert und ich seh nicht warum.

Vielen Dank schon mal.

Gruß
cbli

      Select Case value

        Case movgroesse <= 1023
          movbez = " Bytes"  
          
        Case movgroesse >= 1024 And movgroesse <= 1048575
        
          movgroesse = movgr / 1024
          movgroesse = FormatNumber(movgroesse,2,TristateTrue,TristateFalse,TristateTrue)
          movgroesse = Round(movgroesse,2)
	  movbez = " KB"  
		  	
        Case movgroesse >= 1048576 And movgroesse <= 1043741824
        
          movgroesse =  movgr / 1024 / 1024
          movgroesse = FormatNumber(movgroesse,2,TristateTrue,TristateFalse,TristateTrue)
          movgroesse = Round(movgroesse,2)
          movbez = " MB"  
        
        Case movgroesse >= 1043741824 And movgroesse <= 1099511627776
        
          movgroesse =  movgr / 1024 / 1024 / 1024
          movgroesse = FormatNumber(movgroesse,2,TristateTrue,TristateFalse,TristateTrue)
          movgroesse = Round(movgroesse,2)
          movbez = " GB"  
          
        Case movgroesse >= 1099511627777 And movgroesse <= 8796093022208
        
          movgroesse =  movgr / 1024 / 1024 / 1024 / 1024
          movgroesse = FormatNumber(movgroesse,2,TristateTrue,TristateFalse,TristateTrue)
          movgroesse = Round(movgroesse,2)
          movbez = " TB"  
          
        Case Else
        
          movgroesse = 0

      End Select
Member: bastla
bastla Jul 17, 2015 updated at 14:27:29 (UTC)
Goto Top
Hallo cbli!

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
Grüße
bastla
Member: cbli
cbli Jul 17, 2015 updated at 18:52:36 (UTC)
Goto Top
Hallo Bastla!

Vielen Dank für deine Hilfe.
Funktioniert sehr gut.

Ich wollte jetzt aber noch die Dateien in der Auflistung auf bestimmte Dateien mit bestimmten Endungen beschränken.
d.h. das Script sollte nicht alle Dateien zählen,anzeigen und auflisten, sondern nur die Dateien mir den Endungen die ich vorher festlege.

Wie kann ich das soweit noch einschränken ? Über ein Array ? Oder das Dictionary vorher mit Werten füllen ? Eine Sortierung der Dateiendungen ist nicht unbedingt notwendig, da es ja
momentan nur max 15 verschiedene Dateiendungen gibt, die ich filtern will.

Nachtrag: Wenn möglich sollte auch die Gesamtanzahl + Gesamtgröße aller Dateien mit nur den gewünschten Dateiendungen ausgegeben werden.

Beispiel (nicht komplett)

aTypen = Array("avi", "mpg", "mpeg", "wmv", "mov", "mp4", "iso", "mkv", "m2ts", "ts", "idx", "sub", "rmvb", "srt")  

	For Each sTyp In aTypen 'Dateitypen  
            
		ofilecounter = 0
            
			For Each oFile In fso.GetFolder(moveordner).Files 						'Quelldateien  
                
				If LCase(fso.GetExtensionName(oFile.Path)) = sTyp Then
                    
					ofilecounter = ofilecounter + 1

Gruß
cbli
Member: bastla
Solution bastla Jul 17, 2015 updated at 19:44:21 (UTC)
Goto Top
Hallo cbli!

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
Grüße
bastla
heart1
Member: cbli
cbli Jul 17, 2015 at 19:48:42 (UTC)
Goto Top
Hallo Bastla!

Herzlichen Dank für deine Hilfe, es könnte nicht besser funktionieren.
Hier kann zu.
Und wiederum habe ich etwas gelernt von dir.
Auch dafür vielen Dank.

Wünsche noch ein schönes Wochenende.

Gruß
cbli
Member: bastla
bastla Jul 17, 2015 at 19:55:34 (UTC)
Goto Top
Hallo cbli!

Freut mich face-smile

Schönes WE
bastla
GermansolvedQuestionVB for ApplicationsDevelopment
Hotly discussed
gleixnerdCheck of ZFW Firewallgleixnerd - 5 Comments