Pfad in UserForm
01.05.2021 08:07:40
Daniel
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