Hallo Thorsten,
also ich hab mal das ganze noch etwas umgebaut und die Funktion IsInArray weggelassen. Ich habe jetzt 2 Inputboxen eingebaut, 1 für den Teil des Dateinamens, der gesucht ist und 1 für die Dateiendung. Auch die Liste wird jetzt vor der neuen Suche geleert.
Das mit dem Pfad zu eurem Server musst du mit deiner IT schauen. Ich hab mal im Code den Pfad zu unserem Server drin gelassen, damit du siehst, wie das bei uns aussieht. Kein Problem, wenn du das siehst, hast ja eh keinen Zugriff.
Also lösch mal den anderen Code von mir und benutz folgenden:
Option Explicit
Sub Dateisuche()
Dim Suche As String, Suche2 As String
Dim lngLast As Long
Suche = InputBox("Bitte Suchbegriff eingeben", Suche)
If Suche <> "" Then
Suche2 = InputBox("Bitte gesuchte Dateiendung eingeben", Suche2)
If Suche2 <> "" Then
lngLast = ThisWorkbook.Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row
ThisWorkbook.Sheets("Sheet1").Range("A2:A" & lngLast).ClearContents
LoopThroughFolder "\\murplfp01\Workgroups\Frontline Managers\Presentations", Suche, Suche2 'hier den Pfad zu deinem Hauptordner angeben
End If
End If
End Sub
Public Sub LoopThroughFolder(path As String, Filter As Variant, Filter2 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 InStr((oFile.Name), Filter) <> 0 Then
If InStr((oFile.Name), Filter2) <> 0 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
End If
Next
Loop
End Sub
Gruss Torsten
|