AW: Datei suchen
18.08.2022 11:47:06
Rudi
Hallo,
aus meiner Mottenkiste:
Option Explicit
Dim wksStart As Worksheet, wksInhalt As Worksheet, vntFiles(), lngFiles As Long
Dim strSuch As String
Sub prcFolders()
Dim FSO As Object, oFolder As Object
Dim strFolder As String
Application.ScreenUpdating = False
Set wksStart = ThisWorkbook.Sheets("Start")
On Error Resume Next
Set wksInhalt = ThisWorkbook.Sheets("Inhalt")
On Error GoTo 0
If wksInhalt Is Nothing Then
Set wksInhalt = Worksheets.Add
wksInhalt.Name = "Inhalt"
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
strFolder = wksStart.Cells(1, 2)
If strFolder = "" Then strFolder = GetDirectory
If strFolder = "" Then Exit Sub
strSuch = Application.InputBox("Dateiname?", "Suchbegriff")
If strSuch = "Falsch" Then Exit Sub
strSuch = LCase("*" & strSuch & "*")
Set oFolder = FSO.getfolder(strFolder)
lngFiles = 1
With wksInhalt
.Range("A:C").ClearContents
.Cells(1, 1) = "Pfad"
.Cells(1, 2) = "Dateiname"
.Range(.Cells(1, 1), .Cells(1, 3)).Font.Bold = True
End With
prcFiles oFolder
prcSubFolders oFolder
With wksInhalt
.Range(.Cells(2, 1), .Cells(lngFiles, 2)).FormulaLocal = WorksheetFunction.Transpose(vntFiles)
.Activate
End With
End Sub
Sub prcSubFolders(oFolder)
Dim oSubFolder As Object
For Each oSubFolder In oFolder.subfolders
prcFiles oSubFolder
prcSubFolders oSubFolder
Next
End Sub
Sub prcFiles(oFolder)
Dim oFile As Object
For Each oFile In oFolder.Files
If LCase(oFile.Name) Like strSuch Then
ReDim Preserve vntFiles(1 To 2, 1 To lngFiles)
vntFiles(1, lngFiles) = oFolder.Path
vntFiles(2, lngFiles) = "=hyperlink(""" & oFile.Path & """;""" & oFile.Name & """)"
lngFiles = lngFiles + 1
End If
Next
End Sub
Gruß
Rudi