Excel User Form Files Drag & Drop

Question

I'd like to implement a Drag&Drop object on a User Form in Excel 2016. The purpose is to allow Drag&Drop of files (from Windows Files Explorer) onto the Excel User Form, and catch the drop event to extract file(s) path and names.

So far, I found it is achievable with a very old control that is not provided in recent years anymore by Microsoft - the Treeview control. This control works perfect for my need, however, requires a special registration on of an old OCX and a TLB file that are not common on standard users' run-time machines, not are common (and working) their registration tools, such as Regtlibv12 / Regtlib on new Windows 10 with Office 2016 64bit.

I wonder - is it possible that Microsoft offers no controls to to this in recent years? Do you know if this is achievable with standard Windows 10 and Office 2016 64bit offerings?

Answer 1

You can do this by hooking the userform, and using the Windows API I adapted some code from Here

Note this copyright:

' This code was originally written by Dev Ashish. ' It is not to be altered or distributed, ' except as part of an application. ' You are free to use it in any application, ' provided the copyright notice is left unchanged. ' ' Code Courtesy of ' Dev Ashish

(Although I've adapted some of it) In the userform, put this code:

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal 
lpClassName As String, ByVal lpWindowName As String) As Long

Function hWnd() As Long
Dim hWndThis As Long
If Val(Application.Version) > 8 Then
    hWndThis = FindWindow(lpClassName:="ThunderDFrame", lpWindowName:=Me.Caption)
Else
    hWndThis = FindWindow(lpClassName:="ThunderXFrame", lpWindowName:=Me.Caption)
End If
hWnd = hWndThis
End Function

Private Sub UserForm_Initialize()
Call sEnableDrop(Me, hWnd)
Call sHook(hWnd)
End Sub

Private Declare Function apiCallWindowProc Lib "user32" _
Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hWnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) _
As Long

Private Declare Function apiSetWindowLong Lib "user32" _
Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal wNewWord As Long) _
As Long

Private Declare Function apiGetWindowLong Lib "user32" _
Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) _
As Long

Private Declare Sub sapiDragAcceptFiles Lib "shell32.dll" _
Alias "DragAcceptFiles" _
(ByVal hWnd As Long, _
ByVal fAccept As Long)

Private Declare Sub sapiDragFinish Lib "shell32.dll" _
Alias "DragFinish" _
(ByVal hDrop As Long)

Private Declare Function apiDragQueryFile Lib "shell32.dll" _
Alias "DragQueryFileA" _
(ByVal hDrop As Long, _
ByVal iFile As Long, _
ByVal lpszFile As String, _
ByVal cch As Long) _
As Long

Private lpPrevWndProc  As Long
Private Const GWL_WNDPROC  As Long = (-4)
Private Const GWL_EXSTYLE = (-20)
Private Const WM_DROPFILES = &H233
Private Const WS_EX_ACCEPTFILES = &H10&
Private hWnd_Frm As Long

Sub sDragDrop(ByVal hWnd As Long, _
                        ByVal Msg As Long, _
                        ByVal wParam As Long, _
                        ByVal lParam As Long)

Dim lngRet As Long, strTmp As String, intLen As Integer
Dim lngCount As Long, i As Long, strOut As String
Const cMAX_SIZE = 50
On Error Resume Next
If Msg = WM_DROPFILES Then
    strTmp = String$(255, 0)
    lngCount = apiDragQueryFile(wParam, &HFFFFFFFF, strTmp, Len(strTmp))
    For i = 0 To lngCount - 1
        strTmp = String$(cMAX_SIZE, 0)
        intLen = apiDragQueryFile(wParam, i, strTmp, cMAX_SIZE)
        strOut = strOut & Left$(strTmp, intLen) & ";"
    Next i
    strOut = Left$(strOut, Len(strOut) - 1)
    Call sapiDragFinish(wParam)
    MsgBox strOut

Else
    lngRet = apiCallWindowProc( _
                        ByVal lpPrevWndProc, _
                        ByVal hWnd, _
                        ByVal Msg, _
                        ByVal wParam, _
                        ByVal lParam)
End If
End Sub

Sub sEnableDrop(frm As UserForm, hWnd As Long)
Dim lngStyle As Long, lngRet As Long
lngStyle = apiGetWindowLong(hWnd, GWL_EXSTYLE)
lngStyle = lngStyle Or WS_EX_ACCEPTFILES
lngRet = apiSetWindowLong(hWnd, GWL_EXSTYLE, lngStyle)
Call sapiDragAcceptFiles(hWnd, True)
hWnd_Frm = hWnd
End Sub


Sub sHook(hWnd As Long)
lpPrevWndProc = apiSetWindowLong(hWnd, GWL_WNDPROC, AddressOf sDragDrop)
End Sub

Sub sUnhook(hWnd As Long)
Dim lngTmp As Long
lngTmp = apiSetWindowLong(hWnd, GWL_WNDPROC, lpPrevWndProc)
lpPrevWndProc = 0
End Sub

The sDragDrop function puts the file list to a messagebox, but you can set a variable to store it.

OF course, as it is hooking the window, then it is a risk to stability!