AW: VBA/Daten lesen aus xlsm in Unterordnern
23.05.2023 21:28:40
Pappawinni
Mit Collection ist es wahrscheinlich schöner...
Option Explicit
Public Sub StartCollectingFilePaths()
Dim colPaths As Collection
Dim path
Dim i As Long
'Hier Pfad und Dateiname einsetzen, Beispiel:
'arrPath = findFileInFolders("C:\Users", "Test.xlsm")
Set colPaths = findFileInFolders("C:\Users", "Quat_Test.xlsx")
If colPaths.Count = 0 Then
MsgBox "no item found"
Exit Sub
End If
MsgBox colPaths.Count & " item(s) found"
For Each path In colPaths
' Hier kannst du dann deine Files nacheinander abarbeiten....
Debug.Print path
Next
End Sub
Function findFileInFolders(ByVal SourceFolderName As String, ByVal fileName As String) As Collection
'Erzeugt ein Array für Pfade in denen die Datei fileName zu finden ist
'Die Suche erfolgt rekursiv in SourceFolderName und dessen Subfolder, ausgenommen System und Hidden Folders
Dim FSO As Object, SourceFolder As Object, SubFolder As Object
Dim FileItem
Dim Result As New Collection
Dim SubResult As Collection
Dim i As Long, j As Long, x
DoEvents
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.GetDrive(FSO.GetDriveName(SourceFolderName)).path = SourceFolderName Then
Set SourceFolder = FSO.GetDrive(FSO.GetDriveName(SourceFolderName)).RootFolder
Else
Set SourceFolder = FSO.GetFolder(SourceFolderName)
End If
For Each FileItem In SourceFolder.Files
If UCase(FileItem.Name) = UCase(fileName) Then
Result.Add FileItem.path
Exit For
End If
Next FileItem
For Each SubFolder In SourceFolder.SubFolders
If Not ((SubFolder.Attributes And (vbSystem + vbHidden)) > 0) Then
Set SubResult = findFileInFolders(SubFolder.path, fileName)
If SubResult.Count > 0 Then
For Each x In SubResult
Result.Add x
Next
End If
End If
Next SubFolder
Set findFileInFolders = Result
End Function