Tipp 0034 Dateisuche mit dem FileSearch-Objekt
Autor/Einsender:
Datum:
  Angie
19.11.2004
Entwicklungsumgebung:   Word 2000
Für die Dateisuche in einem vorgegebenen Verzeichnis wird die FileSearch-Methode des Application-Objekts benutzt. Mit dem Parameter
  .NewSearch werden die Suchkriterien auf die Standardeinstellungen zurückgesetzt.
(Die Eigenschaftswerte werden nach jeder durchgeführten Suche beibehalten.)
  .FileName wird die Auswahl der Dateiendung festgelegt.
  .LookIn wird das Verzeichnis festgelegt, in dem gesucht werden soll.
  .SearchSubFolders wird festgelegt, ob auch die Unterverzeichnisse durchsucht werden sollen.
Die Suche beginnt mit der Execute-Methode, in diesem Beispiel nach Namen sortiert. Mit der FoundFiles-Methode wird sowohl die Anzahl (.FoundFiles.Count) als auch der Dateiname inkl. Pfad (.FoundFiles(Index)) der gefundenen Dateien im angegebenen Verzeichnis zurückgegeben.
 
Option Explicit

Private Const mc_Title As String = _
                 "Dateisuche mit dem FileSearch-Objekt"

Private Sub UserForm_Initialize()
  Me.Caption = mc_Title
  Me.txtLookIn.Text = CurDir

  Me.lblFilesCnt.Caption = "Datei(en) gefunden"
  Me.lblFileName.Caption = ""

  Me.chkSubFolders.Value = False

  With Me.cboFileFilter
    .AddItem ".doc"
    .AddItem ".dot"
    .AddItem ".txt"
    .AddItem "*.*"

    .ListIndex = 0
  End With

  With Me.lstFiles
    .Clear
    .BoundColumn = 0
    .ColumnCount = 3
    .ColumnWidths = "0"
  End With
End Sub

Private Sub cmdSearch_Click()
  Dim strLookIn As String

  Me.lblFileName.Caption = ""
  Me.lstFiles.Clear

  strLookIn = Trim$(Me.txtLookIn.Text)
  If Len(strLookIn) = 0 Then
    MsgBox "Bitte geben Sie das Verzeichnis ein, " & _
           "in dem nach Dateien gesucht werden soll.", _
           vbOKOnly + vbInformation, mc_Title

    Me.txtLookIn.SetFocus
    Exit Sub
  End If

  If Len(Dir(strLookIn, vbDirectory)) = 0 Then
    MsgBox "Das angegebene Verzeichnis existiert nicht!", _
           vbOKOnly + vbInformation, mc_Title
    Me.txtLookIn.SetFocus
    Exit Sub
  End If

  Dim avarFiles As Variant

  If Me.cboFileFilter.Text = "*.*" Then
    avarFiles = _
          GetFileSearch(strLookIn, , Me.chkSubFolders.Value)
  Else
    avarFiles = GetFileSearch(strLookIn, _
               Me.cboFileFilter.Text, Me.chkSubFolders.Value)
  End If

  If IsArray(avarFiles) Then
    Me.lblFilesCnt.Caption = _
           CStr(UBound(avarFiles, 2)) & " Datei(en) gefunden"
    Me.lstFiles.Column() = avarFiles
    Me.lstFiles.ListIndex = 0
  Else
    Me.lblFilesCnt.Caption = "Keine Datei(en) gefunden"
  End If
End Sub

Private Sub lstFiles_Click()
  With Me.lstFiles
    Me.lblFileName.Caption = .List(.ListIndex, .BoundColumn)
  End With
End Sub

Private Function GetFileSearch(ByVal sLookIn As String, _
      Optional varFileFilter As Variant, Optional _
      fSearchSubfolders As Boolean = False) As Variant

  Dim astrFiles() As String
  Dim nFilesCnt   As Long
  Dim n           As Long
  Dim strFileName As String

  On Error Resume Next

  With Application.FileSearch
    .NewSearch
    .LookIn = sLookIn
    .SearchSubFolders = fSearchSubfolders

    If Not IsMissing(varFileFilter) Then
      .FileName = varFileFilter
    Else
      .FileType = msoFileTypeAllFiles
    End If

    If .Execute(SortBy:=msoSortByFileName, _
            SortOrder:=msoSortOrderAscending, _
            AlwaysAccurate:=True) > 0 Then

      nFilesCnt = .FoundFiles.Count
      ReDim astrFiles(1 To 3, 1 To nFilesCnt)

      For n = 1 To nFilesCnt
        strFileName = .FoundFiles(n)
        astrFiles(1, n) = strFileName
        astrFiles(3, n) = FileDateTime(strFileName)

        Do
          strFileName = Right$(strFileName, _
                (Len(strFileName) - InStr(strFileName, "\")))
        Loop While InStr(strFileName, "\") > 0
        astrFiles(2, n) = strFileName
      Next

      GetFileSearch = astrFiles
    End If
  End With

  On Error GoTo 0
End Function
 
Hinweis
In der im Download befindlichen frm-Datei ist der Code ausführlich kommentiert. Die Datei kann für Excel und PowerPoint im jeweiligen Programm im VB-Editor importiert werden.

Windows-Version
95
98/SE
ME
NT
2000
XP
Vista
Win 7
Anwendung/VBA-Version
Access 97
Access 2000
Access XP
Access 2003
Access 2007
Access 2010
Excel 97
Excel 2000
Excel XP
Excel 2003
Excel 2007
Excel 2010
Word 97
Word 2000
Word XP
Word 2003
Word 2007
Word 2010
PPT 97
PPT 2000
PPT XP
PPT 2003
PPT 2007
PPT 2010
Outlook 97
Outlook 2000
Outlook XP
Outlook 2003
Outlook 2007
Outlook 2010


Download  (16,8 kB) Downloads bisher: [ 2493 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Samstag, 27. August 2011