VBA Ordner Rekursiv durchsuchen nach Dateien

Nabend,

kann mir jemand sagen, ob es möglich ist diesen Code so anzupassen, dass auch Unterordner durchsucht werden?
Ich brauche nur die Zahl der Dateien. Wenn es Unterordner gibt brauche ich dennoch nur die Gesamtzahl der Dateien.

Public Function CountFiles(ByVal Pfad As String, _
  Optional ByVal DateiTyp As String = "*.*") As Long  
 
  On Error GoTo ErrHandler
 
  Dim Counter As Integer
  Dim TempName As String
 
  If Right$(Pfad, 1) <> "\" Then Pfad = Pfad & "\"  
 
  TempName = Dir$(Pfad & DateiTyp)
  While Len(TempName) > 0
    If TempName <> "." And TempName <> ".." Then  
      Counter = Counter + 1
    End If
    TempName = Dir$
   Wend
 
ErrHandler:
  CountFiles = Counter
End Function

Grüße

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

Content-ID: 1115181476

Url: https://administrator.de/contentid/1115181476

Ausgedruckt am: 18.11.2024 um 20:11 Uhr

7 Kommentare

Neuester Kommentar

Funktion rekursiv für alle Unterordner aufrufen ...
Erstellen rekursiver Prozeduren

bsp.

Option Compare Text
Public fso As Object

Public Function CountFiles(ByVal Pfad As String, Optional ByVal DateiTyp As String = "*.*") As Long  
    Dim cnt As Long
    For Each file In fso.GetFolder(Pfad).Files
        If file.Name Like DateiTyp Then
            cnt = cnt + 1
        End If
    Next
    For Each subfolder In fso.GetFolder(Pfad).Subfolders
        cnt = cnt + CountFiles(subfolder.Path, DateiTyp)
    Next
    CountFiles = cnt
End Function

Sub ZähleDateien()
    Set fso = CreateObject("Scripting.FileSystemObject")  
    msgbox CountFiles("D:\testordner", "*.*")  
End Sub

(Achtung "Option Compare Text" muss an den Anfang des Codefensters ganz oben)
Klappt natürlich nur wenn der User auch alle Ordner und Dateien sehen kann und ihm nicht Zugriffsrechte auf Unterordner fehlen.

@149062: Ich danke dir. Du hast mir den Abend gerettet!

@149062

hast du dazu auch noch eine Idee? Ich finde keine wirkliche Lösung.

Die Exceldatei wird mit Onedrive synchronisiert. D.h. sie liegt zwar im lokalen Onedrive-Ordner, aber beim Pfad auslesen liest er den Pfad von Onedrive aus. Damit kann ich leider nichts anfangen.
Ich brauche den lokalen Pfad.

CurDir liest offenbar nur den Standardspeicherpfad aus und ThisWorkbook.path eben den Onedrivepfad vom Sharepoint, also https:// usw.

Hab dann das noch gefunden:

Public Function filedir()
    With CreateObject("Scripting.FileSystemObject")  
        absolutepath = .GetAbsolutePathName(ThisWorkbook.name)
    End With
    filedir = absolutepath
End Function

Aber das liest irgendwie auch nur den Pfad von den d:\Eigenen Dateien aus und mal d:\Eigene Dateien\Desktop (Das ist bei mir der Speicherort vom Desktop)

Onedrive liegt aber unter c:\users\profilname\onedrive

Grüße

https://stackoverflow.com/questions/33734706/excels-fullname-property-wi ...

Hab ich gefunden und getestet und bekomme immer einen Fehler bei

  endFilePath = Mid(fullPath, iPos)

Grüße

Zitat von @Xaero1982:

Hab ich gefunden und getestet und bekomme immer einen Fehler bei

>   endFilePath = Mid(fullPath, iPos)
> 

Grüße

Dann hast du der Funktion den falschen Pfad übergeben, guckst du klappt doch

Mh wenn ich das Solo ausführe oder den restlichen Code - gehts.
Na ich schaue es mir die Tage nochmal an. Habs es nun erstmal über die Umgebungsvariable %Onedrive% gelöst.

Danke dir!

gelöst Frage VB for Applications Entwicklung

Mehr von Xaero1982

Netphone-Swyx-Server - Colt-SipTrunkXaero1982 - 2 Kommentare

Telekom BSP Rufnummernumleitung für FaxXaero1982 - 3 Kommentare

Microsoft CSP Registrierung - EinzelunternehmerXaero1982 - 8 Kommentare

WLAN - 1 SSID - 2+ Subnetze + NPS -ServerXaero1982 - 17 Kommentare

Heiß diskutiert