Excel-Funktion für 'Anzahl Dateien in Ordner...'

R_o_b · 9. November 2019 um 23:30

Salu Kenner,
salu Reinhard,

mit welcher Funktion kann ich die Anzahl und Gesamtgröße von Dateien in einem bestimmten Ordner zurückbekommen?

Vielen Dank :o)
-R o b.

Mario_02e442 · 9. November 2019 um 23:30

Hey Rob,

eine Möglichkeit wäre folgende

Public Function ErmittleDateienAnzahl(sPath As String) As Long
Dim sFile As String
Dim lFiles As Long
sPath = IIf(Right$(sPath, 1) = „“, sPath, sPath & „“)
sFile = Dir$(sPath, vbDirectory)
Do While sFile „“

If sFile „.“ And sFile „…“ Then
If (GetAttr(sPath & sFile) And vbNormal) = vbNormal Then
lFiles = lFiles + 1
End If
End If
sFile = Dir
Loop
ErmittleDateienAnzahl = lFiles
End Function

Public Sub Beispiel()
MsgBox „Im Pfad C:\ befinden sich " & ErmittleDateienAnzahl(„C:“) & " Dateien“
End Sub

greetz

Mario

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

R_o_b · 9. November 2019 um 23:31

Prima! Vielen Dank. Eine Nachfrage…
Salu Mario,

vielen vielen Dank. Klappt bestens.

Wenns nicht zu unverschämt ist: Welche Funktion gibt die Größe eines Ordners (Pfad wird übergeben) zurück?

Ein Sternchen habbich Dir jedenfalls schon mal vergeben :o) Nochmals besten Dank.
-R o b.

Mario_02e442 · 9. November 2019 um 23:31

Hab dir das ganze mal zusammengeschustert :o))

Public Function ErmittleDateienAnzahl(sPath As String, ByRef lSize As Long) As Long
Dim sFile As String
Dim lFiles As Long
sPath = IIf(Right$(sPath, 1) = „“, sPath, sPath & „“)
sFile = Dir$(sPath, vbDirectory)
Do While sFile „“

If sFile „.“ And sFile „…“ Then
If (GetAttr(sPath & sFile) And vbNormal) = vbNormal Then

lSize = lSize + FileLen(sPath & sFile)

lFiles = lFiles + 1
End If
End If
sFile = Dir
Loop
ErmittleDateienAnzahl = lFiles
End Function

Public Sub Beispiel()
Dim lGroesse As Long
Dim DateiAnzahl As Long
Dim sSize As String

DateiAnzahl = ErmittleDateienAnzahl(„C:“, lGroesse)

sSize = DoConv(lGroesse)

MsgBox "Im Pfad C:\ befinden sich " & CStr(DateiAnzahl) & " Dateigröße " & sSize
End Sub

Private Function DoConv(Number As Long) As String
If Number = 1024 And Number = (1024& * 1024&amp:wink: And Number = (1024& * 1024& * 1024&amp:wink: Then DoConv = CStr(Round(Number / 1024 / 1024 / 1024, 2)) & " GB"
End Function

Mario

Anno74 · 9. November 2019 um 23:31

Hallo Mario,

sehr nett geschrieben. Nur was mir beim Überfliegen aufgefallen ist.

1: Ist in dem Ordner ein Unterverzeichnis mit diversen Dateien, so werden sie nicht mit gezaehlt. Von daher ist die Angabe der Dateien in dem Ordner, in dem Falle falsch

2: Du bestimmst die Groesse. Du weisst die Grösse einer Variablen zu die als Long declariert ist. Soweit sogut. Nur Der Datentyp kann einen maximalen Wert von 2 147 483 647 annehmen kann.
Nehmen wir den Wert einmal als Byte

2147483647 Byte -> 2097151,9990234375 KByte
2097151,9990234375 KByte -> 2047,9999… MByte
2047,999 MByte -> 1,999… GB

Ich habe auf meinem Rechner Verzeichnise liegen, wo def. mehr als 2 GB an Daten ist. Ist zur heutigen Zeit auch normal
Nehmen wir einmal an. Er setzt deine Variante auf ein Verzeichnis an was zum bsp. 15 GB hat. Dann bekommt er einen Laufzeitfehler! Ok diesen kann man weglutschen aber dann bekommt er dennoch nicht die gewünschte Ausgabe. Max. Ne Fehlermeldung das das Volumen grösser als 2 GB ist. Aber lange Rede kurzer Sinn. Besser wäre es die Variable als Variant oder Double zu declarieren. Beide Varianten belegen 8 Byte Speicherplatz. Ergo 4 Bytes mehr und ich denke mal das das vertretbar ist. Desweiteren sollte auch hier mind. ein On Local Error … verwendet werden, denn man weiss ja nie, was manche Leute so an Daten in ihren Verzeichnissen liegen haben

MfG Alex

Anno74 · 9. November 2019 um 23:31

Kaum abgeschickt so faellt mir ein das eine Aussage nicht richtig war
Verwendet man den Datentyp Variant und nutzt ihn für zahlen so belegt er 16 Bit und speichert auch nur max. die Werte wie Double. Von daher weg vom Variant und Double nehmen

MfG Alex

Hanno_f96ef8 · 9. November 2019 um 23:31

Werte ohne Schleifen abfragen
Hmm, das müsste doch auch eleganter gehen, ohne fehlerträchtige Schleifen-Summe. Gibt es keine Objekte, mit denen sich direkt auf die Werte zugreifen läßt?

Viele Grüße
Hanno

Public Function ErmittleDateienAnzahl(sPath As String, ByRef
lSize As Long) As Long
Dim sFile As String
Dim lFiles As Long
sPath = IIf(Right$(sPath, 1) = „“, sPath, sPath & „“)
sFile = Dir$(sPath, vbDirectory)
Do While sFile „“

If sFile „.“ And sFile „…“ Then
If (GetAttr(sPath & sFile) And vbNormal) = vbNormal Then

lSize = lSize + FileLen(sPath & sFile)

lFiles = lFiles + 1
End If
End If
sFile = Dir
Loop
ErmittleDateienAnzahl = lFiles
End Function

Mario_02e442 · 9. November 2019 um 23:31

Hallo Alex,

jupp, da hast du Recht. Zu Punkt 1: Soweit ich verstanden habe, sollten die Dateien in diesem Verzeichnis gezählt werden.
Wenn die Unterordner eingeschlossen werden sollen, dann muss man daraus eine rekursive Suche machen. Dann würde ich aber API empfehlen, da Dir$ nicht die schnellste Variante ist.

Zu Punkt 2: Jupp, den Dateityp sollte man auf Variant ändern.
Wobei ich sagen muss, dass die von mir geschriebene Variante, ein schneller Entwurf ist.

Bzgl. der API-Variante und der Ordnergröße, orientier dich dann besser an diesem Tipp
http://www.vb-fun.de/cgi-bin/loadframe.pl?ID=vb/tipp…

greetz

Mario

[Bei dieser Antwort wurde das Vollzitat nachträglich automatisiert entfernt]

R_o_b · 9. November 2019 um 23:35

Belegter Platz klappt nicht
Salute Mario,

Public Function ErmittleDateienAnzahl(sPath As String, ByRef
lSize As Long) As Long
Dim sFile As String
Dim lFiles As Long
sPath = IIf(Right$(sPath, 1) = „“, sPath, sPath & „“)
sFile = Dir$(sPath, vbDirectory)
Do While sFile „“

If sFile „.“ And sFile „…“ Then
If (GetAttr(sPath & sFile) And vbNormal) = vbNormal Then

lSize = lSize + FileLen(sPath & sFile)

lFiles = lFiles + 1
End If
End If
sFile = Dir
Loop
ErmittleDateienAnzahl = lFiles
End Function

Public Sub Beispiel()
Dim lGroesse As Long
Dim DateiAnzahl As Long
Dim sSize As String

DateiAnzahl = ErmittleDateienAnzahl(„C:“, lGroesse)

sSize = DoConv(lGroesse)

MsgBox "Im Pfad C:\ befinden sich " & CStr(DateiAnzahl) & "
Dateigröße " & sSize
End Sub

Private Function DoConv(Number As Long) As String
If Number = 1024 And Number = (1024& * 1024&amp:wink: And Number = (1024& * 1024& * 1024&amp:wink: Then DoConv =
CStr(Round(Number / 1024 / 1024 / 1024, 2)) & " GB"
End Function

Vielen Dank für so viel Mühe :o) Doch leider klappt die Messung des belegten Platzes nicht: Ich bekomme regelmäßig zu kleine Werte, teilweise sogar negative Werte! Wat nu?

Ein’ schöhn’ Feiertach wünscht
-R o b.

Mario_02e442 · 9. November 2019 um 23:35

Hi Rob,
ich hab das ganze jetzt nochmal mit API gemacht, da die Rekursiv-Suche sonst zu lange dauert. Außerdem noch die Deklaration angepasst und somit sollte es klappen.

Option Explicit

Private Declare Function FindFirstFile Lib „kernel32“ _
Alias „FindFirstFileA“ (ByVal lpFileName As String, _
lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindNextFile Lib „kernel32“ _
Alias „FindNextFileA“ (ByVal hFindFile As Long, _
lpFindFileData As WIN32_FIND_DATA) As Long

Private Declare Function FindClose Lib „kernel32“ (ByVal _
hFindFile As Long) As Long

Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type

Const MAX_PATH As Long = 259&

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Const FILE_ATTRIBUTE_ARCHIVE As Long = &H20&
Const FILE_ATTRIBUTE_COMPRESSED As Long = &H800&
Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10&
Const FILE_ATTRIBUTE_HIDDEN As Long = &H2&
Const FILE_ATTRIBUTE_NORMAL As Long = &H80&
Const FILE_ATTRIBUTE_READONLY As Long = &H1&
Const FILE_ATTRIBUTE_SYSTEM As Long = &H4&
Const FILE_ATTRIBUTE_TEMPORARY As Long = &H100&

Dim dSize As Double

Public Sub ErmittleOrdnerEigenschaft(sPath As String, UnterordnerEinbeziehen As Boolean)
Dim Max As Double
Dim dFolderSize As Double
Dim sSize As String
Screen.MousePointer = 11
DoEvents

Max = GetAllFiles(LCase(sPath), „*“, UnterordnerEinbeziehen)

sSize = DoConv(dSize)

Screen.MousePointer = 0
MsgBox "Verzeichnis " & sPath & vbNewLine & Max & " Dateien " & vbNewLine & " Ordnergröße " & sSize & vbNewLine & "Unterordner einbezogen " & UnterordnerEinbeziehen
End Sub

’ Durchsucht einen Ordner nach Dateien
’ Sollte der Ordner selbst nicht durchsucht werden können,
’ gibt die Funktion 0 zurück. Sonst wird die Anzahl der Dateien
’ zurückgegeben
Private Function GetAllFiles(ByVal Root As String, _
ByVal Such As String, _
Optional DoRecursion As Boolean = False) As Double

Dim File As String
Dim hFile As Long
Dim FD As WIN32_FIND_DATA

’ Evtl. Array vergrößern?

DoEvents

'Backslash ergänzen
If Right(Root, 1) „“ Then Root = Root & „“

’ Die erste Datei suchen
hFile = FindFirstFile(Root & „*.*“, FD)

’ Es konnte nichts gefunden werden
If hFile = 0 Then
GetAllFiles = 0
Exit Function
End If

’ Für jede Datei
Do
’ Den Dateinamen extrahieren
File = Left(FD.cFileName, InStr(FD.cFileName, Chr(0)) - 1)

’ Ist die Datei ein Verzeichnis?
If (FD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY) _
= FILE_ATTRIBUTE_DIRECTORY Then

’ . und … ignorieren
If (File „.“) And (File „…“) Then

’ Unterordner auch durchsuchen?
If DoRecursion Then

’ Unterordner rekursiv erfassen
GetAllFiles = GetAllFiles + GetAllFiles(Root & File, _
Such, DoRecursion)
Else

'GetAllFiles = GetAllFiles + 1

’ Evtl. Array vergrößern

End If
End If
Else

’ Passt das Suchmuster?
If (Such Like Right$(UCase$(File), Len(Such))) Or Such = _
„*“ Then

GetAllFiles = GetAllFiles + 1

dSize = dSize + FileLen(Root & File)

End If
End If

’ Nächste Datei suchen
Loop While FindNextFile(hFile, FD)

’ Suchhandle wieder freigeben - Suche beenden
Call FindClose(hFile)
End Function

Private Function DoConv(Number As Double) As String
If Number = 1024 And Number = (1024& * 1024&amp:wink: And Number = (1024& * 1024& * 1024&amp:wink: Then DoConv = CStr(Round(Number / 1024 / 1024 / 1024, 2)) & " GB"
End Function

Public Sub Beispiel()
ErmittleOrdnerEigenschaft „C:\windows“, True
End Sub

Wenn du beim Aufruf ErmittleOrdnerEigenschaft ein False übergibst, dann werden die Unterordner nicht mit einbezogen.

greetz

Mario

Langhaxada · 9. November 2019 um 23:44

Hi Rob,

oder so:

Public fso As New FileSystemObject 'Verweise: Microsoft Scripting Runtime („scrrun.dll“)

Sub VerzeichnisInfo()
Dim filDatei As File
Dim folVerzeichnis As Folder
Dim intAnzahl As Integer
Dim lngSummeGröße As Long

intAnzahl = 0
lngSummeGröße = 0
Set folVerzeichnis = fso.GetFolder(„C:“)
For Each filDatei In folVerzeichnis.Files
intAnzahl = intAnzahl + 1
lngSummeGröße = lngSummeGröße + filDatei.Size
Next
End Sub

Viele Grüße
Martin

R_o_b · 10. November 2019 um 00:01

Vielen Dank :o)
Salu Martin,

oder so:

Public fso As New FileSystemObject 'Verweise: Microsoft
Scripting Runtime („scrrun.dll“)

Sub VerzeichnisInfo()
Dim filDatei As File
Dim folVerzeichnis As Folder
Dim intAnzahl As Integer
Dim lngSummeGröße As Long

intAnzahl = 0
lngSummeGröße = 0
Set folVerzeichnis = fso.GetFolder(„C:“)
For Each filDatei In folVerzeichnis.Files
intAnzahl = intAnzahl + 1
lngSummeGröße = lngSummeGröße + filDatei.Size
Next
End Sub

Ich werd’s in kürze testen. Leider kam ich vorher nicht dazu, Dir zu antworten und vor allem: zu danken! Vielen vielen Dank dafür (und ein Sternchen).

Grüßken :o)
-R o b.