Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Bestimmte Unterordner durchsuchen | Herbers Excel-Forum


Betrifft: Bestimmte Unterordner durchsuchen von: Luu
Geschrieben am: 10.12.2009 13:12:59

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

  

Betrifft: AW: Bestimmte Unterordner durchsuchen von: fcs
Geschrieben am: 10.12.2009 16:44:13

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



Beiträge aus den Excel-Beispielen zum Thema "Bestimmte Unterordner durchsuchen"