AW: Drag and Drop Feld
10.07.2020 13:42:50
Hajo_Zi
ich habe in Deiner Userform eine Listbox eregänzt, ich bin davon ausgangen die Vielen Namen möchtest Du nicht in eine Textbox schreiben.
In einem Modul
Option Explicit
'- für dieses Beispiel muß im VBA Editor unter Extra, Verweise Microsoft Scripting Runtime _
aktiviert werden
Sub SearchInFolder(ByVal Folderspec As String)
' Dieser Source stammt von http://www.activevb.de
' und kann frei verwendet werden. Für eventuelle Schäden
' wird nicht gehaftet.
' Der VB Code ist aus dem Beitrag _
http://www.activevb.de/tipps/vb6tipps/tipp0492.html
' auslesen aufrufen mit Ordnername
Dim FSO As New FileSystemObject
Dim SearchFolder As Folder
Dim FD As Folder, FI As File
Dim EachFil As Files, EachFold As Folders
Dim LoI As Long ' Laufvariable zum schreiben der Ordner
Set SearchFolder = FSO.GetFolder(Folderspec)
Set EachFil = SearchFolder.Files ' Dateien in der jeweiligen Root
For Each FI In EachFil ' Schleife über alle Dateien
' Ergänzung Hajo
' Dateityp feststellen
If UCase(Right(FI.Name, 3)) = "JPG" Then
If LoI = 0 Then
UserForm1.lst_Bilder.AddItem FI.Name
Else
UserForm1.lst_Bilder.AddItem FI.Name
End If
LoI = LoI + 1
End If
Next FI
Set EachFil = Nothing
Set EachFold = Nothing
Set FSO = Nothing
End Sub
in Userform
Option Explicit
Private Sub lst_Bilder_Click()
If lst_Bilder "" Then
Range("A1") = lst_Bilder
End If
End Sub
Private Sub UserForm_Activate()
'* H. Ziplies *
'* 28.08.16 *
'* erstellt von HajoZiplies@WEB.de *
'* http://Hajo-Excel.de
Dim StOrdner As String
StOrdner = "I:\Privat\Hajo\100627 Erdbeerhof"
Application.ScreenUpdating = False ' Bildschirmaktulalisierung aus
' Zeile aus Originalcode
SearchInFolder StOrdner ' Sub aufrufen
Application.ScreenUpdating = True ' Bildschirmaktualisierung ein
End Sub
Dateien von Herber hebe ich nicht auf da kein sprechender Name.
Beachte den kopletten Beitrag.
Gruß Hajo