http://dieseyer.de • all rights reserved • © 2011 v11.4

'v3.6*****************************************************
' File: Datei-Verzeichnis-Liste.vbs
' Autor: dieseyer@gmx.de
' http://dieseyer.de
'
' Listet alle Dateien und danach alle Verzeichnisse
' in einem / dem aktuellen Verzeichnis
' Zieht man ein Verzeichnis oder eine Datei auf das Skript
' werden zu diesem Verzeichnis die Info's angezeigt.
'*********************************************************

Option Explicit ' Siehe http://dieseyer.de/dse-wsh-lernen.html#OptionExpl

Dim WSHShell, fso, oArgs
Dim oFolders, oSubFolder, oFiles, Folder
Dim i, Text, Pfad, DateiX, VerzX, Verz(), Datei()

Set WSHShell = WScript.CreateObject("WScript.Shell")
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
set oArgs = Wscript.Arguments

If oArgs.Count > 0 Then ' gibt es Argumente?
Pfad = oArgs.item(0) ' erstes Argument

if fso.FileExists( Pfad ) then Pfad = fso.GetParentFolderName( Pfad )
' obige Zeile wird nur ausgeführt, wenn "Pfad" eine Datei ist

Else ' es gibt keine Argumente!
Pfad = fso.GetFolder( "." ) ' Verzeichnis, in dem sich das Skript befindet
End If

if not fso.FolderExists( Pfad ) then
MsgBox UCase(Pfad) & " existiert nicht!" & vbCRLF & vbCRLF & " . . . das ist das Ende.", , WScript.ScriptName
WScript.Quit
End If


' Dateiliste an Array übergeben
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
i = 0
Set oFolders = fso.GetFolder( Pfad )
Set oFiles = oFolders.Files
For Each DateiX In oFiles
ReDim Preserve Datei(i)
Datei(i) = DateiX.Name
i = i + 1
Next
Set oFiles = nothing
Set oFolders = nothing

' Array an Text übergeben
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Text = ""
If i > 0 then ' wenn es Datei(en) gibt
For i = 0 to UBound( Datei )
Text = Text & Pfad & "\" & Datei(i) & vbCRLF
Next
Else
Text = "keine Dateien vorhanden."
End If

MsgBox UCase(Pfad) & " enthält folgende " & i+1 & " Dateien:" & vbCRLF & vbCRLF & Text, , WScript.Scriptname


' Verzeichnisliste an Array übergeben
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
i = 0
Set oFolders = fso.GetFolder( Pfad )
Set oSubFolder = oFolders.SubFolders
For Each VerzX In oSubFolder
ReDim Preserve Verz(i)
Verz(i) = VerzX.Name
i = i + 1
Next
Set oFiles = nothing
Set oFolders = nothing

' Array an Text übergeben
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Text = ""
If i > 0 then ' wenn es Verzeichnis(se) gibt
For i = 0 to UBound( Verz )
Text = Text & Pfad & "\" & Verz(i) & vbCRLF
Next
Else
Text = "keine Unterverzeichnisse vorhanden."
End If

MsgBox UCase(Pfad) & " enthält folgende " & i & " Verzeichnisse:" & vbCRLF & vbCRLF & Text, , WScript.Scriptname


http://dieseyer.de • all rights reserved • © 2011 v11.4