Ausgabe von Ordner-Informationen (Größe, usw.) Dieser Tipp zeigt, wie sich folgende Ordner-Informationen ermitteln lassen: Größe, Anzahl Unterordner und Dateien
Autor:   Helmut Suhren	Bewertung:     [ Jetzt bewerten ]	Views:  29.309
ohne Homepage	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 38 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.0 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Unser heutiger Tipp zeigt, wie sich unter Einbeziehung des FileSystemObjekt (FSO) folgende Ordner-Informationen ermitteln lassen:

• Gesamtgröße des Ordners
• Anzahl enthaltener Unterordner
• Anzahl enthaltener Dateien

Setzen Sie hierzu zunächst einen Verweis auf die Microsoft Scripting Runtime-DLL (Menü Projekt - Verweise).

Und hier der Code

' Ordner-Informationen ermitteln
' + Gesamtgröße
' + Anzahl enthaltener Ordner
' + Anzahl enthaltener Dateien
Private Sub GetFolderInfo(ByVal FolderSpec As String, _
  ByRef folder_cnt As Long, ByRef file_cnt As Long, _
  ByRef folder_size As Currency)
 
  Dim FSO As Scripting.FileSystemObject
  Dim nFolder As Folder
 
  ' Verweis auf FSO-Objekt
  Set FSO = New Scripting.FileSystemObject
 
  ' ggf. abschließenden Backslash hinzufügen
  If Right$(FolderSpec, 1) <> "\" Then _
    FolderSpec = FolderSpec & "\"
 
  ' Prüfen, ob der Ordner existsiert
  If FSO.FolderExists(FolderSpec) Then
    ' Folder-Objekt erstellen
    Set nFolder = FSO.GetFolder(FolderSpec)
 
    ' Größe des Ordners
    folder_size = nFolder.Size
 
    ' Informationen über alle Unterordner und
    ' Dateien ermitteln
    Call zGetFolderInfo(nFolder, folder_cnt, file_cnt)
 
    ' Anzahl Gesamt-Ordner
    folder_cnt = folder_cnt + nFolder.SubFolders.Count
 
    ' Anzahl Gesamt-Dateien
    file_cnt = file_cnt + nFolder.Files.Count
 
    ' Folder-Objekt "zerstören"
    Set nFolder = Nothing
  End If
 
  Set FSO = Nothing
End Sub

' Informationen über Unrdordner ermitteln
' ACHTUNG REKURSIV!
Private Sub zGetFolderInfo(ByVal nFolder As Folder, _
  ByRef folder_cnt As Long, ByRef file_cnt As Long)
 
  Dim nSubFolder As Folder
 
  For Each nSubFolder In nFolder.SubFolders
    ' Hier wird die Funktion rekursiv aufgerufen!
    Call zGetFolderInfo(nSubFolder, folder_cnt, file_cnt)
 
    ' Anzahl Unterordner aktualisieren
    folder_cnt = folder_cnt + nSubFolder.SubFolders.Count
 
    ' Anzahl Dateien aktualisieren
    file_cnt = file_cnt + nSubFolder.Files.Count
  Next
End Sub

' Skalierte Darstellung der Bytes in der entsprechend
' best darstellbaren Größenangabe
Private Function Bytes2String(Bytes As Currency) As String
  Dim EinheitName As Variant
  Dim EinheitFormat As Variant
 
  EinheitName = Array("Byte", "Byte", "Byte", "KB", _
    "KB", "KB", "MB", "MB", "MB", "GB", "GB", "GB", "TB", "TB", "TB")
 
  EinheitFormat = Array("0", "0", "0", "0.00", "0.0", _
    "0.0", "0.00", "00.0", "0.0", "0.00", "0.0", "0.0", "0.00", _
    "0.0", "0.0")
 
  Dim i As Integer
 
  i = Int(Log10(Bytes))
  Bytes2String = Format$(Bytes / 1024 ^ Int(i / 3), _
    EinheitFormat(i)) & " " & EinheitName(i)
End Function

Static Function Log10(X As Currency) As Currency
  If X = 0 Then
    Log10 = 0
  Else
    Log10 = Log(X) / Log(10#)
  End If
End Function

Beispiel

Dim file_cnt As Long
Dim folder_cnt As Long
Dim folder_size As Currency
Dim sFolderPath As String
 
Screen.MousePointer = vbHourglass
sFolderPath = "c:\windows"
GetFolderInfo sFolderPath, folder_cnt, _
  file_cnt, folder_size
 
lblInfo(0).Caption = Bytes2String(folder_size)
lblInfo(1).Caption = CStr(folder_cnt)
lblInfo(2).Caption = CStr(file_cnt)
Screen.MousePointer = vbNormal