VBA Drag & Drop filepath

[jorispk]

Hi guys,

Yesterday I got some stuff working with dropping content from listbox to listbox.

No I'm trying to get a path from an external file, but I'm still not able to figure out a way to get the filepath...

This is what I have:

Private Sub test_BeforeDragOver(ByVal Cancel As MSForms.ReturnBoolean, ByVal Data As MSForms.DataObject, ByVal X As Single, ByVal Y As Single, ByVal DragState As Long, _
    ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
    Cancel = True
    Effect = 1
End Sub
Private Sub test_BeforeDropOrPaste(ByVal Cancel As MSForms.ReturnBoolean, ByVal Action As Long, ByVal Data As MSForms.DataObject, ByVal X As Single, _
    ByVal Y As Single, ByVal Effect As MSForms.ReturnEffect, ByVal Shift As Integer)
    Cancel = True
    Effect = 1
    Dim MyDataObject As DataObject
    Set MyDataObject = New DataObject
    'MyDataObject = GetObject(Data.Files(1))
    Me.test = MyDataObject
End Sub

I thought maybe something as Data.Files(1) would work but it doesn't. The Drag and drop feature works fine though if I say for example Me.test = "check" than it becomes that after dragging the file.

Any suggestions how to get the filepath??

Thank you

 

[Jaafar Tribak]

To clarify, yes I was using that demo file itself and the multi-line textbox wasn't working for me, so I switched to a listbox. And now I'm wondering about dragging in multiple files at once, please

Try using the code in Post#58

 

[sktz]

I can still only drag one file at a time into the listbox. When I drag multiple from my file explorer, it just adds the first one to the list

 

[Jaafar Tribak]

I can still only drag one file at a time into the listbox. When I drag multiple from my file explorer, it just adds the first one to the list

Have you tried the workbook demo in post#50. It uses a diff method.

 

[sktz]

Hm. That one crashes Excel. The version I have (uploading here) allows me to drag multiple files into the listbox one at a time, but when I try multiple at once, it only takes the first one. Do you know how I'd solve that? If not, I suppose it's a minor problem.

 

[sktz]

So I asked Chat GPT for help (I know, I know, I'm putting you all out of an unpaid job), and it modified UserForm_Activate to the following, and it works. Couldn't have gotten to a point where AI could figure it out without all your help. Thank you so much again!

Private Sub UserForm_Activate()

#If VBA7 Then
Dim hwnd As LongPtr, HDROP As LongPtr
#Else
Dim hwnd As Long, HDROP As Long
#End If

Const WM_DROPFILES = &H233
Dim tMsg As MSG, sFileName As String * 256
Dim i As Long ' Counter for file index

Call WindowFromAccessibleObject(Me, hwnd)
Call DragAcceptFiles(hwnd, True)

Do While GetMessage(tMsg, 0, 0, 0) And IsWindow(hwnd)
DoEvents
If tMsg.message = WM_DROPFILES Then
HDROP = tMsg.wParam
' Get the number of files dropped
Dim fileCount As Long
fileCount = DragQueryFile(HDROP, -1, "", 0)

For i = 0 To fileCount - 1
' Reset sFileName for each file
sFileName = String(256, 0)
' Get the file path for each file
DragQueryFile HDROP, i, sFileName, Len(sFileName)
' Add the file path to the listbox
pathBox.AddItem Left(sFileName, InStr(sFileName, vbNullChar) - 1)
Next i

Call DragFinish(HDROP)
End If
Call TranslateMessage(tMsg)
Call DispatchMessage(tMsg)
Loop

End Sub

 

[Jaafar Tribak]

@sktz

Glad you made it work and thanks for the feedback.