Option Explicit
Private Type POINTAPI
X As Long
Y As Long
End Type
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=If]#If[/URL] VBA7 Then
Private Type MSG
hwnd As LongPtr
message As Long
wParam As LongPtr
lParam As LongPtr
time As Long
pt As POINTAPI
End Type
Private Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
Private Declare PtrSafe Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As LongPtr, ByVal hWnd2 As LongPtr, ByVal lpsz1 As String, ByVal lpsz2 As String) As LongPtr
Private Declare PtrSafe Sub DragAcceptFiles Lib "shell32.dll" (ByVal hwnd As LongPtr, ByVal fAccept As Long)
Private Declare PtrSafe Sub DragFinish Lib "shell32.dll" (ByVal HDROP As LongPtr)
Private Declare PtrSafe Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal HDROP As LongPtr, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare PtrSafe Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As LongPtr, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare PtrSafe Function WaitMessage Lib "user32" () As Long
Private hwnd As LongPtr
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=Else]#Else[/URL]
Private Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
Private Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hwnd As Long, ByVal fAccept As Long)
Private Declare Sub DragFinish Lib "shell32.dll" (ByVal HDROP As Long)
Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" (ByVal HDROP As Long, ByVal UINT As Long, ByVal lpStr As String, ByVal ch As Long) As Long
Private Declare Function PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Declare Function WaitMessage Lib "user32" () As Long
Private hwnd As Long
[URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=End]#End[/URL] If
Private Const PM_NOYIELD = &H2
Private Const PM_REMOVE = &H1
Private Const WM_DROPFILES = &H233
Private bUnload As Boolean
Private Sub UserForm_Activate()
Dim FileDropMessage As MSG
Dim HDROP As LongPtr
Dim FileName As String * 256
Dim ret As Long
'get the listbox handle
hwnd = FindWindow(vbNullString, Me.Caption)
hwnd = FindWindowEx(hwnd, 0, vbNullString, vbNullString)
hwnd = FindWindowEx(hwnd, 0, vbNullString, vbNullString)
'make the listbox accept dropped file
DragAcceptFiles hwnd, True
bUnload = False
Do
'wait for a file to be dropped
WaitMessage
Call PeekMessage(FileDropMessage, 0, 0, 0, 0)
'if file dropped on the listbox then retrieve the name of the dropped file
If PeekMessage(FileDropMessage, hwnd, WM_DROPFILES, WM_DROPFILES, PM_REMOVE Or PM_NOYIELD) Then
HDROP = FileDropMessage.wParam
ret = DragQueryFile(HDROP, 0, FileName, Len(FileName))
ListBox1.AddItem Left(FileName, ret)
'Release memory
DragFinish HDROP
End If
DoEvents
Loop Until bUnload
End Sub
Private Sub UserForm_Terminate()
'exit msg loop
bUnload = True
End Sub
