xaero1982
Goto Top

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

Content-ID: 1115181476

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

Printed on: December 12, 2024 at 16:12 o'clock

149062
Solution 149062 Aug 02, 2021 updated at 15:55:52 (UTC)
Goto Top
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.
Xaero1982
Xaero1982 Aug 02, 2021 at 16:28:10 (UTC)
Goto Top
@149062: Ich danke dir. Du hast mir den Abend gerettet!
Xaero1982
Xaero1982 Aug 03, 2021 at 10:59:55 (UTC)
Goto Top
@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
149062
149062 Aug 03, 2021 at 12:06:30 (UTC)
Goto Top
Xaero1982
Xaero1982 Aug 03, 2021 at 14:33:25 (UTC)
Goto Top
Hab ich gefunden und getestet und bekomme immer einen Fehler bei

  endFilePath = Mid(fullPath, iPos)

Grüße
149062
149062 Aug 03, 2021 updated at 15:24:00 (UTC)
Goto Top
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 face-wink.

screenshot
Xaero1982
Xaero1982 Aug 04, 2021 at 15:50:09 (UTC)
Goto Top
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!