Office: Unterordner des Pfades mit durchsuchen

Michael1978-Excel · 17. März 2015

Hallo ihr da draußen!

Einmal mehr beschäftigt mich meine Exceltabelle, hier einmal der Link: Download Bildersuche.xlsm (34.08 KB) now. Fast and easy at workupload.com.

Die Datei kann folgendes:

Sie erstellt aus dem Bildname und dem Fotograph einen JPG-Dateinamen:
Bildname*Fotograph*.jpg.
* sind Variablen im Dateinamen.
Gesucht wird die Datei in den 10 Ordnern, die man im Reiter >Age< eingeben kann. Bei einem Treffer wird das Bild geöffnet.
Die Excel-Datei funktioniert so einwandfrei, nicht zuletzt durch Hilfe aus diesem Forum.
Nun ist es aber mein Wunsch, dass nicht nur die 10 Ordner durchsucht werden, die man selber eingibt, sondern auch deren Unterordner.

Ich bekam den Tipp, hier einmal nach Search Subfolder" oder rekursives Dir" zu suchen.
Gesagt getan, kann ja nicht so schwer sein. *mrcool

Oh je.*entsetzt
Bei dem Thema schaue ich dann doch wie das berühmte Schwein ins Uhrwerk.

Ich kann nicht einmal erkennen, wie die Beispiele genau funktionieren, geschweige denn es in meine Datei übertragen.

Deshalb dieser Thread: Kann mir bitte einer von euch den Code so umschreiben, dass auch die Unterordner der Pfade, die ich im Reiter >Age< eingebe, mit berücksichtigt werden?

Über Hilfe bin ich dankbar.

Gruß, Michael *bye

:)

Tinker Bell · 19. März 2015

Hallo
Vielleicht hilft dir dieses Beispiel weiter.

Code:

Option Explicit
Option Compare Text

Const sRootDrive As String = "E:\Bilder\" 'Laufwerk anpassen ohne Leerschlag am Ende!!!
Const sFileName As String = "DSC01557" 'Materiallistennummer welche gesucht werden soll
Const sFType As String = ".jpg" 'Zu berueksichtigende Dateitypen

Sub Start()

Call MWReadSubFolder(sRootDrive)
End Sub

Private Sub MWReadSubFolder(ByVal sDrive As String)
Dim oFSO As Object
Dim oFolder As Object
Dim oSubFolder As Object
Dim oFile As Object
Dim strSearch1 As String
Dim strSuche As String
Dim sh

strSuche = "*" & sFileName & "*"

Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.getfolder(sDrive)

For Each oSubFolder In oFolder.SubFolders
Debug.Print oSubFolder.Path
'Alle Dateien auflisten
For Each oFile In oSubFolder.Files
Debug.Print oFile.Name
strSearch1 = oFile.Name
If oFile.Name Like strSuche Then
sh = Shell("C:\WINDOWS\system32\mspaint.exe " & oFile.Path, 3)
End If
Next oFile

'Alle Unterverzeichnisse verarbeiten (rekursiv)
Call MWReadSubFolder(oSubFolder.Path)

Next oSubFolder

Set oFSO = Nothing
Set oFile = Nothing
Set oFolder = Nothing
Set oSubFolder = Nothing

End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Gruss,

Tinker Bell

haklesoft · 19. März 2015

Hallo Michael,

und hier noch mein Beispiel mit rekursivem Dir Code:

Sub listMyFiles()
Dim colFiles As New Collection
Dim i As Long
listFilesInDir "C:\Users\Public", "*.jpg", colFiles, True
If colFiles.Count > 0 Then
For i = 1 To colFiles.Count
Debug.Print i, colFiles(i)
Next i
End If
End Sub

'listFilesInDir schreibt die Fullnames aller gefundenen Dateien im Pfad in die übergebene Collection
'Optional können ausgehend vom Startpfad Unterverzeichnisse mit durchsucht werden
'---------------------------------------------------------------------------------
Private Sub listFilesInDir(sStartPath As String, sPattern As String, colFullNames As Collection, Optional bInSubDirs As Boolean)
On Error Resume Next '(unberechtigte Zugriffe auf Verzeichnisse und Dateien übergehen)
Dim sTemp As String, sRepeat As String
If Right(sStartPath, 1) "\" Then sStartPath = sStartPath & "\"
sTemp = Dir(sStartPath & sPattern)
Do While Len(sTemp)
If sTemp "." And sTemp ".." Then
If (GetAttr(sStartPath & sTemp) And vbDirectory) vbDirectory Then '
colFullNames.Add sStartPath & sTemp
End If
End If
sTemp = Dir()
Loop
If bInSubDirs = True Then
sTemp = Dir(sStartPath, vbDirectory)
Do While Len(sTemp)
If (sTemp ".") And (sTemp "..") Then
If (GetAttr(sStartPath & sTemp) And vbDirectory) = vbDirectory Then
listFilesInDir sStartPath & sTemp, sPattern, colFullNames, bInSubDirs
sRepeat = Dir(sStartPath, vbDirectory)
Do While sRepeat sTemp
sRepeat = Dir()
Loop
End If
End If
sTemp = Dir()
Loop
End If
On Error GoTo 0
End Sub
Klicke in dieses Feld, um es in vollständiger Größe anzuzeigen.

Michael1978-Excel · 23. März 2015

Hallo,

danke für die Beispiele.
Leider komme ich den nächsten 2 Wochen nicht dazu die einmal "umzuschreiben".
Sobald ich einen vorzeigbaren Code habe, werde ich mich hier wieder melden.

Gruß, Michael

Office: Unterordner des Pfades mit durchsuchen

Unterordner des Pfades mit durchsuchen

Unterordner des Pfades mit durchsuchen

Unterordner des Pfades mit durchsuchen

Unterordner des Pfades mit durchsuchen - Similar Threads - Unterordner Pfades durchsuchen

Schriftgröße in Email Unterordner ändern...

Outlook Emails inkl. aller Unterordner pro Tag zählen/auswerten

VBA Unterordner

Ordner mit Unterordner per VBA erstellen

Posteingang Unterordner entfernen

auch Unterordner berücksichtigen

MS Teams / SharePoint übergeordnete Ordner lassen sich nicht löschen, wenn Unterordner oder ...