Hallo dorschtn,
ich heiße übrigens auch Torsten
Nachfolgende Funktionen sollten deinen Zweck erfüllen. Pack den gesamten Code in ein allgemeines Modul und nimm die in den Kommentaren angegebenen Änderungen vor. Dann starte mal die Sub "Dateisuche". Ich denke, Spalten kannst du selber ändern, wenn du es nicht in Spalte A und B haben möchtest
Sollte noch was unklar sein oder nicht funktionieren, einfach wieder melden.
Option Explicit
Sub Dateisuche()
Dim Suche As String
Suche = InputBox("Bitte Suchbegriff eingeben", Suche)
If Suche <> "" Then
LoopThroughFolder "C:\Users\tw\Documents", Suche 'hier den Pfad zu deinem Hauptordner angeben
End If
End Sub
Public Sub LoopThroughFolder(path As String, Filter As Variant)
Dim fso, oFolder, oSubfolder, oFile, queue As Collection
Dim lngLast As Long
On Error Resume Next 'Falls Permission denied nächsten Folder/File nehmen (quick n dirty)
Set fso = CreateObject("Scripting.FileSystemObject")
Set queue = New Collection
queue.Add fso.GetFolder(path)
Do While queue.Count > 0
Set oFolder = queue(1)
queue.Remove 1
For Each oSubfolder In oFolder.SubFolders
If oSubfolder <> vbEmpty Then queue.Add oSubfolder
Next
For Each oFile In oFolder.Files
If oFile <> vbEmpty Then
If IsInArray(fso.GetExtensionName(oFile.path), Filter) Then
With ThisWorkbook.Sheets("Sheet1") 'hier dein Tabellenblatt angeben, wo die Liste hin soll
lngLast = .Cells(Rows.Count, 1).End(xlUp).Row + 1
.Cells(lngLast, 2) = oFile.path 'die Pfade werden in Spalte B geschrieben, kannst du auch weglassen
.Hyperlinks.Add anchor:=.Cells(lngLast, 1), Address:=oFile.path, TextToDisplay:=oFile.Name 'die Links kommen in Spalte A
End With
End If
End If
Next
Loop
End Sub
Function IsInArray(str As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, str)) > -1)
End Function
Gruß Tor
|