Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Pfad in UserForm

Pfad in UserForm
01.05.2021 08:07:40
Daniel
Guten Morgen
Ich habe im Forum einen Code gefunden und dieser möchte ich etwas anpassen. Doch krieg ich das nicht hin!
Es sollte mir in einem ausgewählten Ordner (den ausgewählten Ordner inkl. Unterordner) die Datei "Mappe1.xlsx" suchen.
Danach sollte das Ergebnis (Pfad) in einer ListBox aufgelistet werden. Ist die Datei nicht vorhanden, so sollte in der Listbox "Datei nicht vorhanden!" stehen.
Kann mir an Hand dieser Zeilen jemand helfen?
Gruss Daniel Eberhard

Option Explicit                                     ' Variablendfefinition Erforderlich
Dim StOrdner As String                              ' Variable für Verzeichnis
Dim StTyp As String                                 ' Dateityp
Private Sub Cmd_Verzeichnis_Click()
StOrdner = GetAOrdner                           ' Verzeichnis auswählen
If StOrdner = "" Then
MsgBox "Es wurde kein Ordner ausgewählt!"
Else
StTyp = "Mappe1.xlsx"
'        StTyp = InputBox("Bitte Dateityp eingeben. " & Chr(13) & _
'            "Es dürfen keine Platzhalter verwendet werden." & Chr(10) & "Für alle Dateien * ", "Dateityp", "XLS")
End If
End Sub
Private Sub Cmd_Start_Click()
If StOrdner = "" Then
MsgBox "Es wurde kein Ordner ausgewählt"
Exit Sub
End If
Application.ScreenUpdating = False              ' Bildschirmaktulalisierung aus
SearchInFolder StOrdner                         ' Sub aufrufen
Application.ScreenUpdating = True               ' Bildschirmaktualisierung ein
Cmd_Start.Caption = "Start"                     ' Beschriftung zurücksetzen
Unload Me                                       ' UserForm verlassen
End Sub
Private Sub Cmd_Ende_Click()
End
End Sub
Private Sub SearchInFolder(ByVal Folderspec As String)
Dim FSO As New FileSystemObject
Dim SearchFolder As Folder
Dim FD As Folder, FI As File
Dim EachFil As Files, EachFold As Folders
Set SearchFolder = FSO.GetFolder(Folderspec)
Set EachFold = SearchFolder.SubFolders      ' Unterordner in der Root
DoEvents                                    ' andere Befehle ausführen
For Each FD In EachFold
SearchInFolder CStr(FD)                 ' Funktion rekursiv aufrufen weitere Unterverzeichnisse
Next FD
Set EachFil = SearchFolder.Files            ' Dateien in der jeweiligen Root
For Each FI In EachFil                      ' Schleife über alle Dateien
If UCase(Right(FI.Name, Len(FI.Name) - InStrRev(FI.Name, "."))) = UCase(StTyp) Or StTyp = "" Or StTyp = "*" Then
MsgBox FI.Path
End If
DoEvents
Next FI
Set EachFil = Nothing
Set FSO = Nothing
End Sub
Anzeige

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Pfad in UserForm
01.05.2021 11:27:15
ralf_b
warum suchst du dir nicht einen passenden Code?
wenn nach einem Dateityp gesucht wird und auch entsprechend geprüft, dann ist es nicht hilfreich noch den Dateinamen in die Variable des Typs zu schreiben.
Eine Listboxreferenz sehe ich auch nicht.
AW: Pfad in UserForm
01.05.2021 12:46:46
Daniel
Hallo ralf_b
Vielen Dank. Aber das hilft mir nicht weiter. Suche schon seit Tagen. Doch viel wird nur nach Dateitypen wie zum Beispiel "*.xls" gesucht und nicht nach einem vollständigen Dateiname wie bei mir "Mappe1".
Gruss Daniel
Anzeige
AW: Pfad in UserForm
01.05.2021 13:03:40
ralf_b
wenn ich der Meinung wäre ,das es nicht hilfreich wäre, dann hätte ich mir die Zeit anders vertrieben.
Offensichtlich sind deine Kenntnisse der Materie dann nicht ausreichend.
Wenn dem so ist, eröffnen sich dann neue Hürden wenn du Codes nicht anpassen kannst.
hier mal ein Beispiel nach einer kurzen Suche und mit Anpassung aber ungetestet. die Codekommentare noch berücksichtigen.
https://www.herber.de/forum/archiv/1712to1716/1713980_Dateien_aus_Unterordner_oeffnen.html#1714979

Option Explicit
Public Sub Beispiel()
Const FOLDER_PATH As String = "C:\Users\D\Documents\Test\" 'Anpassen
Dim astrFolders() As String, strFilename As String
Dim ialngFolders As Long
Dim objWorkbook As Workbook
astrFolders = GetFolders(FOLDER_PATH)
Application.ScreenUpdating = False
For ialngFolders = LBound(astrFolders) To UBound(astrFolders)
strFilename = Dir$(astrFolders(ialngFolders) & "*.xlsm")   'dateityp anpassen
Do Until strFilename = vbNullString
'*************** NEU *****************
if strFilename like "Mappe1" then  Listbox1.aditem strFilename  'Listboxname anpassen
strFilename = Dir$
Loop
Next
Application.ScreenUpdating = True
Set objWorkbook = Nothing
End Sub
Private Function GetFolders(ByVal pvstrPath As String) As String()
Dim astrFolders() As String
Dim strFolder As String, strPath As String
Dim ialngIndex1 As Long, ialngIndex2 As Long
Redim Preserve astrFolders(ialngIndex1)
astrFolders(ialngIndex1) = pvstrPath
ialngIndex1 = 1
ialngIndex2 = 1
strPath = pvstrPath
Do
strFolder = Dir$(PathName:=strPath & "*", Attributes:=vbDirectory)
Do Until strFolder = vbNullString
If strFolder  "." And strFolder  ".." Then
If GetAttr(PathName:=strPath & strFolder) And vbDirectory Then
Redim Preserve astrFolders(0 To ialngIndex1)
astrFolders(ialngIndex1) = strPath & strFolder & "\"
ialngIndex1 = ialngIndex1 + 1
End If
End If
strFolder = Dir$
Loop
If ialngIndex1 = ialngIndex2 Then Exit Do
strPath = astrFolders(ialngIndex2)
ialngIndex2 = ialngIndex2 + 1
Loop
GetFolders = astrFolders
End Function

Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige