Als Antwort auf diesen Beitrag
sorry, da war ich noch nicht richtig munter. Nun die vollständige Version nebst Suchstring:
Option Explicit
Private Const Begriff As String = "Juni"
Private Sub DateienLesen()
Dim strPath$, strFile$, i&, arr()
If strPath = "" Then strPath = ShellVerzeichnisBrowser
If strPath <> "" Then
strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
strFile = Dir(strPath & "*.jpg", vbNormal)
Do While strFile <> ""
If InStr(1, strFile, Begriff, vbTextCompare) > 0 Then
i = i + 1
ReDim Preserve arr(1 To 2, 1 To i)
arr(1, i) = strPath
arr(2, i) = strFile
End If
strFile = Dir
Loop
End If
If strPath <> "" Then
With Tabelle1
.UsedRange.ClearContents
.Cells(1, 1).Resize(UBound(arr, 2), 2) = Application.Transpose(arr)
End With
End If
End Sub
Private Function ShellVerzeichnisBrowser(Optional ByVal defaultPath = "") As String
Dim objItem As Object, objShell As Object, objFolder As Object
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0&, "Bitte Verzeichnis anklicken", 0&, defaultPath)
If objFolder Is Nothing Then GoTo weiter
Set objItem = objFolder.Self
ShellVerzeichnisBrowser = objItem.Path
weiter:
Set objShell = Nothing
Set objFolder = Nothing
Set objItem = Nothing
End Function
https://www.herber.de/bbs/user/180718.xlsm
Gruß Uwe