Bestimmte Unterordner durchsuchen

Hallo zusammen!
Ich habe folgendes Problem:
Auf einem Server werden Ordner mit Projektnamen angelegt, von denen ich keine Ahnung habe wie sie heissen werden. Allerdings wird in diesen Projektordnern immer die gleiche Struktur sein.
Laufwerk Y
---Projekte
------Projekt A
---------Ordner 1
---------Ordner 2
------------neu
------Projekt B
---------Ordner 1
---------Ordner 2
...
Nun kann es noch hinzukommen, dass wie oben gezeigt, in einem der Unterordner noch ein beliebiger vorhanden ist.
Zur Zeit suche ich mit Filesearch nach einem bestimmten Ausdruck. Da aber ca. 140k Dateien durchsucht werden, dauert das "ewig". Gibt es eine Möglichkeit, dass VBA zwar in jedes Projekt reinschaut, dann aber nur immer in Ordner 2 und Unterordner die sich in diesem befinden?
Mit etwas stöbern habe ich in der VBA Hilfe unter "SearchFolders-Auflistung" etwas gefunden, wo bestimmte Ordner durchsucht werden können. Gearbeitet wird mit "Searchscope". Dabei kann ich allerdings nur den Arbeitsplatz angeben und nicht schon da einen bestimmten Ordner. Weiss jemand wie ich das ändern könnte, dann hätte ich da einen Ansatz.
Sollten noch Verständnisfragen sein, bitte melden. Bin für alles dankbar.
Gruß
Luu

Beitrag zum Forumthread

Beitrag zu diesem Forumthread

Betreff

Benutzer

Hallo Luu,
hier eine Mischung aus Dir und FileSearch. Allerdings nicht an einer Mamut-Dateistruktur getestet.
Gruß
Franz

'Erstellt unter Excel 2003
Sub FindFiles_Projekte_Ordner2()
Dim objFS_Ordner2 As FileSearch
Dim obj_P As Variant, obj_Ordner2 As Variant, arrFilesFound() As String
Dim varProjektFolder As Variant, FileCount As Long
On Error GoTo Fehler
'Verzeichnis mit Projektordnern wählen
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Bitte Verzeichnis mit ProjektOrdnern auswählen"
If .Show = -1 Then
varProjektFolder = .SelectedItems(1)
'Ordner der Projekte finden
obj_P = Dir(varProjektFolder & "\*", vbDirectory)
Do Until obj_P = ""
'Prüfen ob gefundenes Element einen Ordner2 enthält
Select Case VBA.GetAttr(obj_P & Application.PathSeparator & "Ordner2")
Case vbDirectory, vbDirectory + vbReadOnly, vbDirectory + vbReadOnly + vbArchive, _
vbDirectory + vbArchive
'Ordner2 durchsuchen
Set objFS_Ordner2 = Application.FileSearch
With objFS_Ordner2
.NewSearch
.LookIn = varProjektFolder & Application.PathSeparator _
& obj_P & Application.PathSeparator & "Ordner2"
.SearchSubFolders = True
'Exceldateien finden
.Filename = "*.xl*"
If .Execute > 0 Then
'Dateien in Array schrieben
For Each obj_Ordner2 In .FoundFiles
FileCount = FileCount + 1
ReDim Preserve arrFilesFound(1 To FileCount)
arrFilesFound(FileCount) = obj_Ordner2
Next
End If
End With
Case Else
'do nothing
End Select
Resume01:
'nächsten ProjektOrdner finden
obj_P = VBA.Dir
Loop
End If
End With
If FileCount > 0 Then
'gefundenen Dateien weiterverarbeiten
'Dateiliste in neue Tabelle ausgeben
Worksheets.Add
For FileCount = 1 To FileCount
'      MsgBox "Datei " & FileCount & "  : " & arrFilesFound(FileCount)
Cells(FileCount + 1, 1) = arrFilesFound(FileCount)
Next
Else
MsgBox "No Files founds"
End If
Fehler:
With Err
Select Case .Number
Case 0
Case 53 'Datei wurde nicht gefunden
'MsgBox "Fehler-Nr. " & .Number & vbLf & .Description
Resume Resume01
Case 76 'Pfad nicht gefunden
'MsgBox "Fehler-Nr. " & .Number & vbLf & .Description
Resume Resume01
Case Else
MsgBox "Fehler-Nr. " & .Number & vbLf & .Description
End Select
End With
End Sub

Beliebteste Forumthreads (12 Monate)

Bestimmte Unterordner durchsuchen

1 Beitrag zum Forumthread Beitrag zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

1
Beitrag zum Forumthread

Beitrag zu diesem Forumthread