6
Dateien aus Ordnerstruktur in Textdatei schreiben, nach Dateinamen sortieren und zusätzlich in HTML in Tabellenform ausgeben
Hallo An Allle
Ich habe ein Script (hier nochmals vielen Dank an Bastla für die Hilfe) welches Dateien mit vorher definierten Endungen aus einem vorher ausgewählten Ordner (incl. aller Unterordner) + den Pfad
in eine Textdatei schreibt.
Die Anzahl der Dateien, sowie die Dateigröße aller Dateien mit den jeweiligen Endungen werden am Ende der Textdatei angefügt.
Dieser Teil funktioniert schon wunderbar, nur nach ausgiebigem Testen ist der Wunsch in mir aufgekommen dieses Script noch um 2 Punkte zu erweitern.
Zum ersten sollten in der Textdatei alle Dateien alphabetisch gelistet aufgeführt werden und zwar jeweils nur für die Ordner in denen sie sich befinden.
Die Pfade sollten auch alphabetisch gelistet aufgeführt werden.
z.B.
c:\test\excel\abc.xls
c:\test\excel\ddfg.xls
c:\test\excel\test.xls
c:\test\word\doc1.doc
c:\test\word\doc2.doc
c:\test\word\sdf.doc
Gibt es eine Möglichkeit einen bestimmten Teil der Zusammenfassung in einer anderen Farbe in der Textdatei anzeigen zu lassen ? (z.B. die Größenangabe )
Außerdem wollte ich wissen wie man diese dann sortierte Textdatei incl. Zusammenfassung noch in HTML in Tabellenform ausgeben kann.
Vielen Dank für die Hilfe.
Gruß
cbli
Hier der Code den ich bereits habe:
Ich habe ein Script (hier nochmals vielen Dank an Bastla für die Hilfe) welches Dateien mit vorher definierten Endungen aus einem vorher ausgewählten Ordner (incl. aller Unterordner) + den Pfad
in eine Textdatei schreibt.
Die Anzahl der Dateien, sowie die Dateigröße aller Dateien mit den jeweiligen Endungen werden am Ende der Textdatei angefügt.
Dieser Teil funktioniert schon wunderbar, nur nach ausgiebigem Testen ist der Wunsch in mir aufgekommen dieses Script noch um 2 Punkte zu erweitern.
Zum ersten sollten in der Textdatei alle Dateien alphabetisch gelistet aufgeführt werden und zwar jeweils nur für die Ordner in denen sie sich befinden.
Die Pfade sollten auch alphabetisch gelistet aufgeführt werden.
z.B.
c:\test\excel\abc.xls
c:\test\excel\ddfg.xls
c:\test\excel\test.xls
c:\test\word\doc1.doc
c:\test\word\doc2.doc
c:\test\word\sdf.doc
Gibt es eine Möglichkeit einen bestimmten Teil der Zusammenfassung in einer anderen Farbe in der Textdatei anzeigen zu lassen ? (z.B. die Größenangabe )
Außerdem wollte ich wissen wie man diese dann sortierte Textdatei incl. Zusammenfassung noch in HTML in Tabellenform ausgeben kann.
Vielen Dank für die Hilfe.
Gruß
cbli
Hier der Code den ich bereits habe:
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 = ":xls:doc:ppt:txt:jpg:bmp:pdf:"
' 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:" & vbNewLine
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
If Len(FormatBySize(V(1))) = 7 Then
Result = Result & vbNewLine & V(0) & vbTab & "Datei(en) mit" & vbTab & " " & FormatBySize(V(1)) & vbTab & "im Format" & vbTab & Typ & vbTab & "wurde(n) gefunden." & vbNewLine
FCount = FCount + V(0) 'Gesamtanzahl hochzählen
FSize = FSize + V(1) 'Gesamtgröße aufaddieren
End If
If Len(FormatBySize(V(1))) = 8 Then
Result = Result & vbNewLine & V(0) & vbTab & "Datei(en) mit" & vbTab & " " & FormatBySize(V(1)) & vbTab & "im Format" & vbTab & Typ & vbTab & "wurde(n) gefunden." & vbNewLine
FCount = FCount + V(0) 'Gesamtanzahl hochzählen
FSize = FSize + V(1) 'Gesamtgröße aufaddieren
End if
If Len(FormatBySize(V(1))) = 9 Then
Result = Result & vbNewLine & V(0) & vbTab & "Datei(en) mit" & vbTab & FormatBySize(V(1)) & vbTab & "im Format" & vbTab & Typ & vbTab & "wurde(n) gefunden." & vbNewLine
FCount = FCount + V(0) 'Gesamtanzahl hochzählen
FSize = FSize + V(1) 'Gesamtgröße aufaddieren
End If
Next
'Gesamtwerte der Ausgabevariablen formatiert hinzufügen
Result = Result & vbNewline & vbNewline & "Es wurden insgesamt " & FCount & " Datei(en) mit einer Gesamtgröße von " & 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) ' Größenwerte umrechnen, Script reicht bis 999 TB
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 < 1099511627776 Then
FormatBySize = FormatNumber(Round(Bytes/1024/1024/1024, 2), 2) & " GB"
ElseIf Bytes < 8796093022208 Then
FormatBySize = FormatNumber(Round(Bytes/1024/1024/1024/1024, 2), 2) & " TB"
End If
End Function
Auf Facebook teilen
Auf Twitter teilen
Auf Reddit teilen
Auf Linkedin teilenBitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben
Content-ID: 277739
Url: https://administrator.de/contentid/277739
Ausgedruckt am: 17.11.2024 um 07:11 Uhr
6 Kommentare
Neuester Kommentar
Moin,
das Sortieren kannst du mit einem ADO Recordset erledigen und dann eben alles mit HTML-Tags umschreiben da ist eine farbliche Gestaltung mit CSS dann kein Problem:
Gruß jodel32
das Sortieren kannst du mit einem ADO Recordset erledigen und dann eben alles mit HTML-Tags umschreiben da ist eine farbliche Gestaltung mit CSS dann kein Problem:
Set fso = CreateObject("Scripting.FileSystemObject")
Set objRec = CreateObject("ADOR.Recordset")
Set bffShell = CreateObject("Shell.Application")
Set d = CreateObject("Scripting.Dictionary")
'Felder des Recordsets setzen
With objRec
.Fields.Append "Path",202,256
.Fields.Append "Type",200,10
End With
objRec.Open
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 = ":xls:doc:ppt:txt:jpg:bmp:pdf:"
Set Liste = fso.OpenTextFile("Liste.txt", 2, True)
SkriptPfad = zielfolder
DoFolders fso.GetFolder(SkriptPfad)
FCount = 0: FSize = 0: Result = "<h2>Dateiliste</h2><table>"
'Recordset nach Pfadnamen sortieren
objRec.Sort = "Path ASC"
'HTML-Tabellenzeilen je nach Typ (Ordner/Datei erstellen)
objRec.MoveFirst
While Not objRec.EOF
If objRec.Fields("Type").Value = "Folder" Then 'Ordner
Result = Result & "<tr><td class=""Folder"">" & objRec.Fields("Path").Value & "</td></tr>"
Else 'Datei
Result = Result & "<tr><td>" & objRec.Fields("Path").Value & "</td></tr>"
End If
objRec.MoveNext
Wend
Result = Result & "</table><h2>Zusammenfassung</h2><table><tr><th>Anzahl Dateien</th><th>Größe</th><th>Format</th></tr>"
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
If Len(FormatBySize(V(1))) = 7 Then
Result = Result & "<tr><td>" & V(0) & "</td><td class=""red"">" & FormatBySize(V(1)) & "</td><td>" & Typ & "</td></tr>"
FCount = FCount + V(0) 'Gesamtanzahl hochzählen
FSize = FSize + V(1) 'Gesamtgröße aufaddieren
End If
If Len(FormatBySize(V(1))) = 8 Then
Result = Result & "<tr><td>" & V(0) & "</td><td class=""red"">" & FormatBySize(V(1)) & "</td><td>" & Typ & "</td></tr>"
FCount = FCount + V(0) 'Gesamtanzahl hochzählen
FSize = FSize + V(1) 'Gesamtgröße aufaddieren
End if
If Len(FormatBySize(V(1))) = 9 Then
Result = Result & "<tr><td>" & V(0) & "</td><td class=""red"">" & FormatBySize(V(1)) & "</td><td>" & Typ & "</td></tr>"
FCount = FCount + V(0) 'Gesamtanzahl hochzählen
FSize = FSize + V(1) 'Gesamtgröße aufaddieren
End If
Next
Result = Result & "</table><p>Es wurden insgesamt " & FCount & " Datei(en) mit einer Gesamtgröße von " & FormatBySize(FSize) & " gefunden</p>"
'HTML Gerüst zusammensetzen
html = "<!DOCTYPE HTML><html><head><meta http-equiv=""Content-Type"" content=""text/html""><title>Dateiliste</title></head><style>.Folder{font-weight:bold;background-color:#C4E5B4}h2{color:Blue}.red{color:red}</style><body>" & Result & "</body></html>"
'HTML in Datei schreiben
Liste.Write html 'Ausgabe Zusammenfassung in Datei
Liste.Close
Msgbox "Die HTML-Datei wurde erfolgreich erstellt !" ,64,"Info"
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 & ".html", True
Case vbNo
fso.CopyFile "Liste.txt","d:\" & "Dateiliste" & " " & date & ".html", True
End Select
Set bootFile = fso.GetFile("Liste.txt")
fso.DeleteFile bootFile, True
Set objRec = Nothing
Set fso = Nothing
Set bffShell = Nothing
Set d = Nothing
' ENDE
'Methods and Functions
Sub DoFolders(Folder)
If LCase(Folder.Name) <> LCase("System Volume Information") Then
'Neues Recordset Objekt für den Ordner erzeugen
With objRec
.AddNew
.Fields("Path").Value = Folder.Path
.Fields("Type").Value = "Folder"
.Update
End With
For Each File In Folder.Files
Typ = LCase(fso.GetExtensionName(File.Name)) ' Dateityp ermitteln
If InStr(Typen, ":" & Typ & ":") > 0 Then ' nur gewünschte Typen berücksichtigen
'Neues Recordset Objekt für die Datei erzeugen
With objRec
.AddNew
.Fields("Path").Value = File.Path
.Fields("Type").Value = "File"
.Update
End With
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
For Each SubFolder In Folder.SubFolders
DoFolders(SubFolder)
Next
End If
End Sub
Function FormatBySize(Bytes) ' Größenwerte umrechnen, Script reicht bis 999 TB
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 < 1099511627776 Then
FormatBySize = FormatNumber(Round(Bytes/1024/1024/1024, 2), 2) & " GB"
ElseIf Bytes < 8796093022208 Then
FormatBySize = FormatNumber(Round(Bytes/1024/1024/1024/1024, 2), 2) & " TB"
End If
End Function
Hallo Jodel32
Erstmal vielen Dank für deine Hilfe.
Habe deine Erweiterung gerade ausgiebig getestet und soweit funktioniert es auch, zumindest solange sich die Dateien auf einem lokalen Laufwerk befinden.
Nutze ich das Script mit einem Ordner der sich auf einem Netzlaufwerk befindet (in meinem Fall eine Freigabe von einem Nas) funktioniert die Sortierung nicht mehr.
Ich verstehe aber nicht warum.
Hast du hier auch eine Lösung für ?
Gruß
cbli
Erstmal vielen Dank für deine Hilfe.
Habe deine Erweiterung gerade ausgiebig getestet und soweit funktioniert es auch, zumindest solange sich die Dateien auf einem lokalen Laufwerk befinden.
Nutze ich das Script mit einem Ordner der sich auf einem Netzlaufwerk befindet (in meinem Fall eine Freigabe von einem Nas) funktioniert die Sortierung nicht mehr.
Ich verstehe aber nicht warum.
Hast du hier auch eine Lösung für ?
Gruß
cbli
Habe den Datentyp für den Pfadnamen im Recordset oben geändert, da gab es wohl Probleme auf Netzlaufwerken mit Unicode Charactern, müsste jetzt gehen...
Hallo Jodel32
Vielen Dank jetzt funktioniert es auch mit dem Ordner auf dem Netzlaufwerk.
Perfekt wäre es jetzt noch wenn das Ganze noch zusätzlich mit meiner ursprünglichen Ausgabe sortiert in meine Textdatei ausgegeben würde.
D.h. ich würde die Ergebnisse gerne sortiert als Textdatei und als HTML Datei erhalten.
Ist das sehr aufwändig ?
Gruß
cbli
Vielen Dank jetzt funktioniert es auch mit dem Ordner auf dem Netzlaufwerk.
Perfekt wäre es jetzt noch wenn das Ganze noch zusätzlich mit meiner ursprünglichen Ausgabe sortiert in meine Textdatei ausgegeben würde.
D.h. ich würde die Ergebnisse gerne sortiert als Textdatei und als HTML Datei erhalten.
Ist das sehr aufwändig ?
Gruß
cbli
Naja, durch anschauen des alten und des neuen Codes hätte das eigentlich auch ein Neuling kombinieren können, aber anscheinend willst du hier nur Code abfischen und nichts lernen 
find ich schade... zumindest selber probieren hätte ich schon erwartet.
find ich schade... zumindest selber probieren hätte ich schon erwartet.Set fso = CreateObject("Scripting.FileSystemObject")
Set objRec = CreateObject("ADOR.Recordset")
Set bffShell = CreateObject("Shell.Application")
Set d = CreateObject("Scripting.Dictionary")
'Felder des Recordsets setzen
With objRec
.Fields.Append "Path",203,256
.Fields.Append "Type",200,10
End With
objRec.Open
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 = ":xls:doc:ppt:txt:jpg:bmp:pdf:"
Set objListeText = fso.OpenTextFile("Liste.txt", 2, True)
Set objListeHTML = fso.OpenTextFile("ListeHTML.txt", 2, True)
SkriptPfad = zielfolder
DoFolders fso.GetFolder(SkriptPfad)
FCount = 0: FSize = 0: strHTML = "<h2>Dateiliste</h2><table>": strText = ""
'Recordset nach Pfadnamen sortieren
objRec.Sort = "Path ASC"
'HTML-Tabellenzeilen je nach Typ (Ordner/Datei erstellen)
objRec.MoveFirst
While Not objRec.EOF
If objRec.Fields("Type").Value = "Folder" Then 'Ordner
strHTML = strHTML & "<tr><td class=""Folder"">" & objRec.Fields("Path").Value & "</td></tr>"
strText = strText & "==================================" & vbNewLine
strText = strText & objRec.Fields("Path").Value & vbNewLine
Else 'Datei
strHTML = strHTML & "<tr><td>" & objRec.Fields("Path").Value & "</td></tr>"
strText = strText & objRec.Fields("Path").Value & vbNewLine
End If
objRec.MoveNext
Wend
strHTML = strHTML & "</table><h2>Zusammenfassung</h2><table><tr><th>Anzahl Dateien</th><th>Größe</th><th>Format</th></tr>"
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
If Len(FormatBySize(V(1))) = 7 Then
strHTML = strHTML & "<tr><td>" & V(0) & "</td><td class=""red"">" & FormatBySize(V(1)) & "</td><td>" & Typ & "</td></tr>"
strText = strText & vbNewLine & V(0) & vbTab & "Datei(en) mit" & vbTab & " " & FormatBySize(V(1)) & vbTab & "im Format" & vbTab & Typ & vbTab & "wurde(n) gefunden." & vbNewLine
FCount = FCount + V(0) 'Gesamtanzahl hochzählen
FSize = FSize + V(1) 'Gesamtgröße aufaddieren
End If
If Len(FormatBySize(V(1))) = 8 Then
strHTML = strHTML & "<tr><td>" & V(0) & "</td><td class=""red"">" & FormatBySize(V(1)) & "</td><td>" & Typ & "</td></tr>"
strText = strText & vbNewLine & V(0) & vbTab & "Datei(en) mit" & vbTab & " " & FormatBySize(V(1)) & vbTab & "im Format" & vbTab & Typ & vbTab & "wurde(n) gefunden." & vbNewLine
FCount = FCount + V(0) 'Gesamtanzahl hochzählen
FSize = FSize + V(1) 'Gesamtgröße aufaddieren
End if
If Len(FormatBySize(V(1))) = 9 Then
strHTML = strHTML & "<tr><td>" & V(0) & "</td><td class=""red"">" & FormatBySize(V(1)) & "</td><td>" & Typ & "</td></tr>"
strText = strText & vbNewLine & V(0) & vbTab & "Datei(en) mit" & vbTab & " " & FormatBySize(V(1)) & vbTab & "im Format" & vbTab & Typ & vbTab & "wurde(n) gefunden." & vbNewLine
FCount = FCount + V(0) 'Gesamtanzahl hochzählen
FSize = FSize + V(1) 'Gesamtgröße aufaddieren
End If
Next
strHTML = strHTML & "</table><p>Es wurden insgesamt " & FCount & " Datei(en) mit einer Gesamtgröße von " & FormatBySize(FSize) & " gefunden</p>"
'HTML Gerüst zusammensetzen
strHTML = "<!DOCTYPE HTML><html><head><meta http-equiv=""Content-Type"" content=""text/html""><title>Dateiliste</title></head><style>.Folder{font-weight:bold;background-color:#C4E5B4}h2{color:Blue}.red{color:red}</style><body>" & strHTML & "</body></html>"
strText = strText & vbNewline & vbNewline & "Es wurden insgesamt " & FCount & " Datei(en) mit einer Gesamtgröße von " & FormatBySize(FSize) & " gefunden."
'HTML in Datei schreiben
objListeHTML.Write strHTML
objListeText.Write strText
objListeText.Close
objListeHTML.Close
Msgbox "Die Dateien(HTML/txt) wurde erfolgreich erstellt !" ,64,"Info"
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
fso.CopyFile "ListeHTML.txt","d:\" & listenname & " " & date & ".html", True
Case vbNo
fso.CopyFile "Liste.txt","d:\" & "Dateiliste" & " " & date & ".txt", True
fso.CopyFile "ListeHTML.txt","d:\" & "Dateiliste" & " " & date & ".html", True
End Select
fso.GetFile("Liste.txt").Delete True
fso.GetFile("ListeHTML.txt").Delete True
Set objRec = Nothing
Set fso = Nothing
Set bffShell = Nothing
Set d = Nothing
' ENDE
'Methods and Functions
Sub DoFolders(Folder)
If LCase(Folder.Name) <> LCase("System Volume Information") Then
'Neues Recordset Objekt für den Ordner erzeugen
With objRec
.AddNew
.Fields("Path").Value = Folder.Path
.Fields("Type").Value = "Folder"
.Update
End With
For Each File In Folder.Files
Typ = LCase(fso.GetExtensionName(File.Name)) ' Dateityp ermitteln
If InStr(Typen, ":" & Typ & ":") > 0 Then ' nur gewünschte Typen berücksichtigen
'Neues Recordset Objekt für die Datei erzeugen
With objRec
.AddNew
.Fields("Path").Value = File.Path
.Fields("Type").Value = "File"
.Update
End With
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
For Each SubFolder In Folder.SubFolders
DoFolders(SubFolder)
Next
End If
End Sub
Function FormatBySize(Bytes) ' Größenwerte umrechnen, Script reicht bis 999 TB
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 < 1099511627776 Then
FormatBySize = FormatNumber(Round(Bytes/1024/1024/1024, 2), 2) & " GB"
ElseIf Bytes < 8796093022208 Then
FormatBySize = FormatNumber(Round(Bytes/1024/1024/1024/1024, 2), 2) & " TB"
End If
End Function
Hallo Jodel32
Zunächst mal vielen Dank für deine Hilfe.
Es funktioniert sehr gut.
Zu deiner Anmerkung möchte ich noch sagen, dass ich nach 4 Jahren Pause vom Script schreiben etliches vergessen hatte und in den letzten 2 Wochen in meinem Urlaub täglich etliche Stunden damit verbracht habe wieder reinzukommen.
Ich war jetzt einfach entnervt , da ich das Problem nicht selber in den Griff bekam und wollte es endlich irgendwie lösen.
Ich werde aber ganz sicher deine Lösung mit meinem Ansatz vergleichen und kann dann vielleicht verstehen wo meine Denkblockade war.
Somit hilfst du mir schon sehr weiter.
Abfischen wollte ich hier eigentlich nix, tut mir leid wenn das so rüberkam,gemeint war es jefenfalls nicht so.
Du kannst mir glauben ich habe die letzten Tage so viel mit probieren verbracht und das erfolglos, dass ich einfach ohne Hilfe von außen aufgegeben hätte.
Nochmals sorry wenn das für dich so aussieht.
Auch nochmal vielen Dank für deine Hilfe.
Gruß
cbli
Zunächst mal vielen Dank für deine Hilfe.
Es funktioniert sehr gut.
Zu deiner Anmerkung möchte ich noch sagen, dass ich nach 4 Jahren Pause vom Script schreiben etliches vergessen hatte und in den letzten 2 Wochen in meinem Urlaub täglich etliche Stunden damit verbracht habe wieder reinzukommen.
Ich war jetzt einfach entnervt , da ich das Problem nicht selber in den Griff bekam und wollte es endlich irgendwie lösen.
Ich werde aber ganz sicher deine Lösung mit meinem Ansatz vergleichen und kann dann vielleicht verstehen wo meine Denkblockade war.
Somit hilfst du mir schon sehr weiter.
Abfischen wollte ich hier eigentlich nix, tut mir leid wenn das so rüberkam,gemeint war es jefenfalls nicht so.
Du kannst mir glauben ich habe die letzten Tage so viel mit probieren verbracht und das erfolglos, dass ich einfach ohne Hilfe von außen aufgegeben hätte.
Nochmals sorry wenn das für dich so aussieht.
Auch nochmal vielen Dank für deine Hilfe.
Gruß
cbli
