Drag&Drop per ListView in UF nach 2 Bed

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub ListView1_OLEDragDrop( _ Data As MSComctlLib.DataObject, _ Effect As Long, _ Button As Integer, _ Shift As Integer, _ x As Single, _ y As Single) Dim lngColumn As Long, lngRow As Long, lngIndex As Long Dim strPath As String, strFile As String, strFolder As String If Data.GetFormat(ccCFFiles) Then lngColumn = ActiveCell.Column lngRow = ActiveCell.Row For lngIndex = 1 To Data.Files.Count strPath = Data.Files(lngIndex) strFile = Dir$(strPath) If strFile vbNullString Then strFile = Left$(strFile, InStrRev(strFile, ".") - 1) Cells(lngRow, lngColumn).Value = strFile lngRow = lngRow + 1 Else strFolder = Dir$(strPath, vbDirectory) If strFolder vbNullString Then Cells(lngRow, lngColumn).Value = strFolder lngRow = lngRow + 1 End If End If Next End If Cells(lngRow, lngColumn).Select End Sub

Hallo Max, zunächst herzl. Dank das du dir die Mühe gemacht hast, ich werde deine Version
auch gerne für anderes verwenden, nur zu dieser Fragestellung bräuchte ich es in der Art das schon der ganze Pfad reingeschrieben wird
( da ich es mit einem anderen Makro anhand der Pfadangabe dann direkt aufrufen kann ) , jedoch hatte mir dein erster Tipp ( aus dem vorherigen Post )
die Dateien mit Endung. abc ( alle eben ) perfekt schnell und sauber gelistet, funktioniert soweit perfekt, nur als ich versuchte irgendwelche Ordner ebenfalls
auf diese Art einzulesen klappte dies so leider nicht, also fing ich an eine entspr. Beispieldatei damit aufzusetzen ( der erste Link hier in dieser Frage ) , da hatte ich die
Abrage schon unterteilt, was eigentlich dann auch schon klappt, es werden dann die Ordner eingelesen, nur hab ich nun ( und das kann ich mir überhaupt nicht erklären ) das Phänomen, dass das Makro versucht gleich nach dem Reinziehen irgendwelcher zuvor ausgewählter Dateien, jede einzelne davon im Nachgang zu öffnen.
Bei den OrdnerDrops kommen nun die besagten 2 Meldungen im Anschluss ( Excel kann auf die Datei ... nicht zugreifen, unter Umständen ist die Datei schreibgeschützt oder verschlüsselt ) dann ok, danach kommt ( Auf ' ... ' konnte nicht zugeriffen werden, unter Umständen ist die Datei beschädigt, befindet sich auf einem anderen Server , oder die Datei ist schreibgeschützt ) ... trifft aber alles nicht zu.
Warum kommt denn dies auf einmal, ich hab die Eigenschaften der ListView extra nochmal mit der in deinem ersten Tipp verglichen, es ist mir ein Rätzel, in den VB Zeilen um das Einlesen steht doch nichts drinn wessen er aufgefordert wird die Dateien explizit zu Öffnen, sind das auf einmal irgendwelche Grundeinstellungen in Excel, warum es sich so verhält, muss ich da evtl. was umstellen , Hyperlinks sinds ja keine ...komisch ?
Fällt dir dazu spontan was ein wo ich ansetzen könnte,
bin dir für deine Tipps wirklich sehr dankbar, und solltest du keine weitere Zeit haben, kein Stress, ich versuch einfach weiter, danke dir jedenfalls sehr
Udo

Private Sub ListView1_OLEDragDrop( _ Data As MSComctlLib.DataObject, _ Effect As Long, _ Button As Integer, _ Shift As Integer, _ x As Single, _ y As Single) Dim lngColumn As Long, lngRow As Long, lngIndex As Long If Data.GetFormat(ccCFFiles) Then lngColumn = ActiveCell.Column lngRow = ActiveCell.Row For lngIndex = 1 To Data.Files.Count Cells(lngRow, lngColumn).Value = Data.Files(lngIndex) lngRow = lngRow + 1 Next End If Cells(lngRow, lngColumn).Select End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range) 'Exit Sub Unload Drag_Drop If Selection.Rows.Count = 1 And ActiveCell.Row > 10 And Cells(ActiveCell.Row, 5) = "" Then If ActiveCell.Column = 5 Then Call Drag_Drop.Show(vbModeless) '

Für Alle die dies mal nachbauen möchten oder ebenfalls benötigen
Die Testdatei ( link ) findet ihr weiter oben ... im Tabellenblatt selbst habe ich Sel.Change nun so aufgebaut :
Option Explicit
'


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Selection.Rows.Count = 1 And ActiveCell.Row > 10 Then
If ActiveCell.Column = 5 And Cells(ActiveCell.Row, 5) = "" Then
If [F9] = "" Then
[F9] = "DD" ' kleiner Hilfsparameter zur Abfrage / Status
Drag_Drop.Show
Drag_Drop.Left = [C12].Value
Drag_Drop.Top = [C13].Value
Exit Sub
End If
End If
If ActiveCell.Column  5 Or Cells(ActiveCell.Row, 5)  "" Then
Unload Drag_Drop
[F9] = ""
End If
End If
End Sub

und die beiden Varianten für die ListView der Userform dann so :
Option Explicit
' dies war mein erster Ansatz ( zumTesten dann umbenennen in ListView1 usw... )
'


Private Sub ListView2_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim lngRow As Long, ialngIndex As Long
Dim strPath As String, strFile As String
If Data.GetFormat(ccCFFiles) Then
lngRow = ActiveCell.Row
'           Pfadangaben die mit irgendeiner Dateiendung enden :
For ialngIndex = 1 To Data.Files.Count
Cells(lngRow, 5).Value = Data.Files(ialngIndex)
lngRow = lngRow + 1
Next
Cells(lngRow, 5).Select
Else
'           Pfadangaben als Ordnerpfade  :
For ialngIndex = 1 To Data.Folder.Count
Cells(lngRow, 5).Value = Data.Folder(ialngIndex)
lngRow = lngRow + 1
Next
Cells(lngRow, 5).Select
End If
End Sub

' Nepumuks effizienterer Code wäre dann dieser Ansatz ( vielen liebn Dank nochmals an der Stelle !! )
'


Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single)
Dim lngColumn As Long, lngRow As Long, lngIndex As Long
If Data.GetFormat(ccCFFiles) Then
lngColumn = ActiveCell.Column
lngRow = ActiveCell.Row
For lngIndex = 1 To Data.Files.Count
Cells(lngRow, lngColumn).Value = Data.Files(lngIndex)
lngRow = lngRow + 1
Next
End If
Cells(lngRow, lngColumn).Select
End Sub

Damit klappt es dann gemixt Pfade ( Dateien und ordner unterschiedlich selektiert ) deren Pfade schnell zu listen abwärts der aktuelle Zeile
in meinem Fall in Spalte 5 ... kann sich jeder dann ja anpassen.
Max, ich danke dir wie immer sehr für deine Hilfe, weis das wirklich zu schätzen, wennich dir auch mal einen Gefallen tun kann schreib mir gerne auf udo-de"at"web.de , vielleicht kann ich mich mal revanchieren, Danke Dir !
Schönen Abend
Udo

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Exit Sub Unload Drag_Drop If Selection.Rows.Count = 1 And ActiveCell.Row > 10 And Cells(ActiveCell.Row, 5) = "" Then If ActiveCell.Column = 5 Then Call Drag_Drop.Show(vbModeless) Drag_Drop.Left = [C12].Value Drag_Drop.Top = [C13].Value Else Unload Drag_Drop End If End If End Sub

Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lngRow As Long, ialngIndex As Long Dim strPath As String, strFile As String If Data.GetFormat(ccCFFiles) Then lngRow = ActiveCell.Row ' Pfadangaben die mit irgendeiner Dateiendung enden : For ialngIndex = 1 To Data.Files.Count Cells(lngRow, 5).Value = Data.Files(ialngIndex) lngRow = lngRow + 1 Next Cells(lngRow, 5).Select Else ' Pfadangaben als Ordnerpfade : For ialngIndex = 1 To Data.Folder.Count Cells(lngRow, 5).Value = Data.Folder(ialngIndex) lngRow = lngRow + 1 Next Cells(lngRow, 5).Select End If End Sub

Beliebteste Forumthreads (12 Monate)

Drag&Drop per ListView in UF nach 2 Bed

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

258 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Drag&Drop per ListView in UF nach 2 Bed

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

258 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread