08.02.2010, aktualisiert um 15:28:35 Uhr

7747

Alle Files in einem Folder Sub zählen

Moin Moin

Ich habe da wieder mal ein gröberes Scripting problem das einfach nicht klappen will
Ich muss alle Files mit jeder beliebigen extension in einem Share aufzählen können und
dann in ein Textfile speichern.

Ich habe folgendes:

On Error Resume Next
Dim fso, folder, files, NewsFile,sFolder
Set fso = CreateObject("Scripting.FileSystemObject")  
Set folder = fso.GetFolder("C:\Documents and Settings\username\My Documents")  
Set outfile = fso.CreateTextFile("c:\testout.txt")  
Set files = folder.Files


For each folderIdx In files
outfile.WriteLine(folderIdx.Name & ";" & folderIdx.DateCreated & ";" & folderIdx.DateLastModified)  
Next
outfile.Close 

Danke für die Hilfe im Voraus

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 135448

Url: https://administrator.de/forum/alle-files-in-einem-folder-sub-zaehlen-135448.html

Ausgedruckt am: 23.12.2024 um 12:12 Uhr

12 Kommentare

Neuester Kommentar

Hallo,

bei mir liefert

cd /d c:\windows
dir /s /b | find /C "C:"  

den Wert 28810. Reicht Dir das?

vG LS

Hallo Itfreak!

Was zeigt die Fehlermeldung, wenn Du "On Error Resume Next" testweise als Kommentar kennzeichnest?

Ändere mal die Codezeile 11 in:

outfile.WriteLine folderIdx.Name & ";" & folderIdx.DateCreated & ";" & folderIdx.DateLastModified  

Gruß Dieter

Leider nid !
Auf so was wäre ich sicher auch gekommen.

Bekomme keine Fehlermeldung, mit deinen Vorschlägen auch nicht!

Hallo itfreak!

Dann versuchs mal damit:

'On Error Resume Next  

Dim fso, folder, subFolder, file

Set fso = CreateObject("Scripting.FileSystemObject")  
Set folder = fso.GetFolder("C:\Documents and Settings\adrian.stadelmann\My Documents")  
Set outfile = fso.CreateTextFile("c:\testout.txt")  
    
For Each subFolder In folder.SubFolders
    For Each file In SubFolder.Files
        outfile.WriteLine folderIdx.Name & ";" & folderIdx.DateCreated & ";" & folderIdx.DateLastModified  
    Next
Next

outfile.Close

Gruß Dieter

oder meintest du soetwas hier:

Set objNetwork = WScript.CreateObject("WScript.Network")  
Username = objNetwork.UserName 


Ordner = "C:\Documents and Settings\" & username & "\My Documents"  
LogPfad = "C:\Z_Ergebnis.txt"  

set fs = createobject("Scripting.FileSystemObject")  

set DateiInfo = fs.CreateTextfile(LogPfad,True)
DateiInfo.close

set DateiInfo = fs.opentextfile(LogPfad, 8)

Listordner Ordner

Sub ListOrdner(ordner)
	On Error resume next

	Set ordner = fs.getfolder(ordner)

	For Each file In ordner.files
		
		Pfadangabe =file.path
		if not Pfadangabe = "" then DateiInfo.writeline (Pfadangabe)  

	Next

	For Each Unterordner In Ordner.subfolders
		
		Pfadangabe = unterordner.path
		Listordner unterordner

	next
End Sub

DateiInfo.close

Set fs = nothing
set DateiInfo = nothing
Set objNetwork = nothing

Gruss
Tsuki

Hallo Tsuki!

Wobei

Zeile 25

If Not Pfadangabe = ""

irgendwie wenig Sinn macht, zumal Each nur gefundene Dateien auflistet, die dann auch eine Pfadangabe haben

Und

Zeile 32

Listordner unterordner

da könnte jetzt eigentlich

Zeile 32

Listordner Pfadangabe

stehen?

Oftmals ist es hilfreich, seinen eigenen Code nochmal durchzulesen

Gruß Dieter

Hallo didi1954,

du hast sicher Recht mit deiner Ausfuehrung!
Aber setze in meinem Script einen falschen Pfad und lasse das ON-Error-Gedingens aktiv.

Desweiteren sollte der TO erst mal deine Frage und deinen Loesungsvorschlag befolgen und dir eine Antwort geben.

Deine Scriptingkenntnisse sind sicher weiter als meine und ich wollte nur eine andere "Tuer" aufzeigen, wie man seinem Problem naeher kommen kann.
Fuer welche Variante er sich letztendlich entscheidet, haengt ganz von ihm ab.

Meine Idee, war keine gestestete und auch keine Fragestellung, OB man das so machen kann.

Also, bitte nicht falschverstehen und nicht am Thema vorbeikommentieren.

Viele Gruesse

Tsuki

Hallo Tsuki!

Jetzt sei nicht gleich eingeschnappt

Ich habe ja nicht geschrieben, dass Dein Script schlechter ist, sondern nur darauf hingewiesen, was man zunächst einmal ändern kann/sollte. Wenn's der TO so verwendet, dann wird es so nicht funktionieren, wie es sollte. Dein Script ist sogar besser als meines, weil es gleich alle Unterordner nach Dateien durchsucht. Also kannst Du jetzt wieder erhobenen Hauptes durch die Firma stolzieren

Gruß Dieter

Hallo Dieter,

vielen Dank fuer die Blumen!

Ich muss ehrlich gestehen, dass ich mein Script nicht getestet hatte!
Mir fielen nur diese Zeilen spontan ein.
Eingeschnappt bin ich nicht und werde es auch nicht sein. Ich mag Anregungen!
Vielen Dank dafuer!
Und selbst wenn ich stolz mit diesem Script durch unsere Firma spazieren wuerde, es wuerde niemanden interessieren

Nun warten wir aber mal lieber auf die Kommentare vom OT/TO

Danach passen wir's an.

Gruss
Tsuki

Hallo Tsuki

Dein Script ist super aber so ws habe ich auch schon aber dein Script
ist ein bissschen schneller als das was ich habe.
Ich müsste am Schluss nur noch eine Zusammenfassung haben von welchee Dateiextension
wieviele Dokumente vorhanden sind.
Das klappt bei mir bei gewissen filelängen & Share inhalt eben nicht zuverlässig!

Danke im Voraus

Gruss Itfreak

Hallo Itfreak!

Das könnte man über Dictionary (assoziative Arrays) machen

In den For Each-File-Schleifen einen "Call AddDictionary" einfügen, wo jede Dateierweiterung erfasst und gezählt wird.

Mit "Call ListDictionary" werden die Dateierweiterungen und deren Anzahl aktuell in Variable "s" übergeben. Hier sollte dann der Code für das Schreiben in eine Datei stehen...

Falls Du nicht erst zum Schluss alles ausgeben willst, dann kann das Array mit einem "Call DelDictionary" zurückgesetzt werden.

Und falls Du die Dateierweitungen lieber in Kleinbuchstaben haben möchtest, dann ändere UCase(..) in LCase(..) um.

Dim dic		'Lokale Variable alle Prozeduren  


Set dic = CreateObject("Scripting.Dictionary")  

....

For Each File In ....
....
    Call AddDictionary(Fs.GetExtensionName(File))
....

Next
....

Call ListDictionary
....


Private Sub AddDictionary(ByRef Extension)
    Dim Ext
    
    Ext = UCase(Extension)
    
    If dic.Exists(Ext) Then dic.Item(Ext) = dic.Item(Ext) + 1 Else dic.Add Ext, 1
End Sub

Private Sub DelDictionary()
    dic.RemoveAll
End Sub

Private Sub ListDictionary()
    Dim Ext, s
    
    For Each Ext In dic.Keys
        s = Ext & " " & dic.Item(Ext)  
    Next
End Sub