API: Drag and Drop from Explorer

Note: In order to test the code in this article, you will need the AddressOf code as well.

    We can use AddressOf to make a form aware that files from Explorer are being dragged and dropped onto it.

    Create a popup form called "frmDragDrop" and on it, create a listbox "lstDrop". Now put this code behind the appropriate events of the form.

'******** Code Start ********
Private Sub Form_Open(Cancel as Integer)
    Call sEnableDrop(Me)
    Call sHook(Me.Hwnd, "sDragDrop")
End Sub

Private Sub Form_Unload(Cancel As Integer)
    Call sUnhook(Me.Hwnd)
End Sub
'******** Code  End ********

Paste this code in a new module.

'************* Code Start *************
' 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
'
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)
        With Forms!frmDragDrop!lstDrop
            .RowSourceType = "Value List"
            .RowSource = strOut
            Forms!frmDragDrop.Caption = "DragDrop: " & _
                                                    .ListCount & _
                                                    " files dropped."
        End With
        
    Else
        lngRet = apiCallWindowProc( _
                            ByVal lpPrevWndProc, _
                            ByVal Hwnd, _
                            ByVal Msg, _
                            ByVal wParam, _
                            ByVal lParam)
    End If
End Sub

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


Sub sHook(Hwnd As Long, _
                strFunction As String)
    lpPrevWndProc = apiSetWindowLong(Hwnd, _
                                            GWL_WNDPROC, _
                                            AddrOf(strFunction))
End Sub

Sub sUnhook(Hwnd As Long)
Dim lngTmp As Long
    lngTmp = apiSetWindowLong(Hwnd, _
                    GWL_WNDPROC, _
                    lpPrevWndProc)
    lpPrevWndProc = 0
End Sub
'**************** Code End ***************

Compile all modules and save. Now open the form and drag a bunch of files from Win Explorer and drop it on the form.