HERBERS
Excel-Forum
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Entdecke rund 2 Millionen Excel-Lösungen im
Forumsarchiv
Forumbeitrag
Excel-Version des Fragestellers:
2022
Erfahrungslevel des Fragestellers:
Excel gut - VBA gut
Alwin Weisangler
20.05.2026 11:31:53
AW: Dateien öffnen
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
Als Antwort auf diesen Beitrag
Alwin Weisangler
20.05.2026 09:08:35
AW: Dateien öffnen
Hallo,

einer von diversen Wegen:



Option Explicit

Private Sub ListBox1Laden()
Dim strPath$, strFile$, i&, Thema As Variant, arr()
Erase arr
If strPath = "" Then strPath = ShellVerzeichnisBrowser
If strPath <> "" Then
strPath = IIf(Right(strPath, 1) = "\", strPath, strPath & "\")
strFile = Dir(strPath & "*.jpg", vbNormal)
Do While strFile <> ""
i = i + 1
ReDim Preserve arr(1 To 2, 1 To i)
arr(1, i) = strPath
arr(2, i) = strFile
strFile = Dir
Loop
End If
If strPath <> "" Then
Tabelle1.Cells(1, 1).Resize(UBound(arr, 2), 2) = Application.Transpose(arr)
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/180717.xlsm

Gruß Uwe
Folgenachrichten
Antwort auf Beitrag erstellen
Bitte einen Anwendernamen ohne @ eingeben.
Bitte das Passwort eingeben.
Bitte eine gültige E-Mail-Adresse eingeben.
Bitte einen Betreff eingeben.
Weitere Optionen
Aktivieren, wenn die Frage/der Beitrag noch nicht beantwortet wurde und unter Listen > Offene Threads erscheinen soll.
Beispieldatei hochladen

Bitte einen Nachrichtentext eingeben.