Forum Discussion
Drag and Drop a file within a form in Microsoft Access 2016 on Windows 10 problem
I have an Access Database that was designed and working fine in Windows 7 with Access 2010. It has a form that allows you to drag a file from the desktop (such as a pdf file) and load the path on the form for further action in order to transport the file over to a folder on a share drive. In Windows 10 and Access 2016, it no longer works. Has something changed with an API reference? I am attaching the code below. I appreciate your input and suggestions on this.
Thanks.
KT
Option Compare Database
Option Explicit
'basDragDrop
'2011-09 jl
Private Declare Function SetWindowLong _
Lib "user32" Alias "SetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long _
) As Long
Private Declare Function GetWindowLong _
Lib "user32" Alias "GetWindowLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long _
) 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 iFile As Long, _
ByVal lpszFile As String, _
ByVal cch As Long _
) As Long
Private Declare Function CallWindowProc _
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
Const GWL_WNDPROC As Long = -4
Const GWL_EXSTYLE = -20
Const WM_DROPFILES = &H233
Const WS_EX_ACCEPTFILES = &H10
Private currFrm As Access.Form 'reference to the Form currently
'hooked to the callback. This
'is required to pass the dropped
'files to the form
Private currHwndFrm As Long 'handle to the currently hooked form
'this is used to verify there isn't
'two forms hooked at the same time
'(for example overlapping controls
'where the mouse jumps from one
'to the other)
Private prevWndProc As Long 'handle to the window's previous
'WindowProc. This is only set while
'currHwndFrm is valid
Private hookOn As Boolean
Public Function DragDropInitForm(hWndFrm As Long)
'inits the form for drag/drop
Dim lExStyle As Long
'get the current extended window style
lExStyle = GetWindowLong(hWndFrm, GWL_EXSTYLE)
'add the flag for accepting dragged files
lExStyle = lExStyle Or WS_EX_ACCEPTFILES
'set the new extended window style
SetWindowLong hWndFrm, GWL_EXSTYLE, lExStyle
'register the form for drag/drop acceptance
DragAcceptFiles hWndFrm, True
End Function
Public Function DragDropSetHook(hookOn As Boolean, hWndFrm As Long)
'toggles the hook on or off
If hookOn Then
dragDropHookOn hWndFrm
'Debug.Print "HookOn"
Else
dragDropHookOff
'Debug.Print "HookOff"
End If
End Function
Public Function DragDropCallback( _
ByVal hWnd As Long, _
ByVal msg As Long, _
ByVal wparam As Long, _
ByVal lparam As Long _
) As Long
'callback for drag/drops
'as in all callbacks, we're screwed if there's an error
'and need to be absolutely certain this procedure will
'exit
On Error Resume Next
'We want to turn this hook off as soon as possible after
'the files are dropped, otherwise it clogs up the rest
'of the project operations. It just so happens that the
'MouseMove event for a control accepting the dropped files
'fires exactly one time when the files are physically
'dropped on the form - that one time is where this hook
'is turned on, so it's almost a safe bet that we can
'turn this directly back off as soon as it's called.
'
'If you experience occasional times where you drop files
'but they do not register, set the DDH_MAXCALLS constant
'to a higher number. In Access 2010 in particular this
'number seems to want to be set around 50 or so for
'it to work every time. You might need to go higher
Const DDH_MAXCALLS = 150
Static intCallCount As Integer
If msg <> WM_DROPFILES Then
'the hWnd parameter passed to this function by the OS is
'the handle to the form that was hooked. If the message
'is not for a file drop, we'll send the message to that
'form's standard message procedure
CallWindowProc ByVal prevWndProc, _
ByVal hWnd, _
ByVal msg, _
ByVal wparam, _
ByVal lparam
Else
'we have a file drop, handle that
dragDropQueryFiles wparam
End If
'check the callcount and unhook if required
intCallCount = intCallCount + 1
If intCallCount >= DDH_MAXCALLS Then
intCallCount = 0
DragDropSetHook False, hWnd
End If
End Function
Private Sub dragDropQueryFiles(hDrop As Long)
'passes a semicolon delimited list of the dropped
'files to the currFrm.DragDropFiles() sub
Const MAX_PATH = 255
Dim ret As String 'function return
Dim s As String 'temp/various
Dim Icount As Integer 'count of files dropped
Dim iPathLen As Integer 'length of the current path
Dim I As Integer 'temp/various
'get the count of files dropped
s = String(MAX_PATH, 0)
Icount = DragQueryFile(hDrop, &HFFFFFFFF, s, Len(s))
'iterate the filecount and build the return
For I = 0 To Icount - 1
s = String(MAX_PATH, 0)
iPathLen = DragQueryFile(hDrop, I, s, MAX_PATH)
ret = ret & ";" & Left(s, iPathLen)
Next I
DragFinish hDrop
currFrm.DragDropFiles Mid(ret, 2)
End Sub
Private Function dragDropHookOn(hWndFrm As Long)
'turns the callback on
If hookOn Then Exit Function
'set the current form and handle for later use
currHwndFrm = hWndFrm
Set currFrm = dragDropGetFrmFromHWnd(hWndFrm)
'use SetWindowLong to set the new callback address
'and return the previous callback address to prevWndProc
prevWndProc = SetWindowLong(hWndFrm, GWL_WNDPROC, AddressOf DragDropCallback)
hookOn = True
End Function
Private Function dragDropHookOff()
'turns the callback off
'set the window's callback address to it's previous value
SetWindowLong currHwndFrm, GWL_WNDPROC, prevWndProc
'clear the window and callback settings until next callback init
prevWndProc = 0
currHwndFrm = 0
Set currFrm = Nothing
hookOn = False
End Function
Private Function dragDropGetFrmFromHWnd(hWnd As Long) As Access.Form
'retrieves a form reference from the form's handle
'this reference is later used to call the form's procedure and pass
'it the dropped file list
Dim frm As Access.Form
For Each frm In Access.Forms
If frm.hWnd = hWnd Then Exit For
Next frm
Set dragDropGetFrmFromHWnd = frm
End Function
- kteslerCopper Contributor
UPDATE...
So I am able to drag and drop a file and this is what I did. I had to click in the form a few times first and then I can drag the file over the form and it will take it.
I think it may have to do with this part of the code:
'If you experience occasional times where you drop files
'but they do not register, set the DDH_MAXCALLS constant
'to a higher number. In Access 2010 in particular this
'number seems to want to be set around 50 or so for
'it to work every time. You might need to go higher
Const DDH_MAXCALLS = 150
Static intCallCount As IntegerAny thoughts or ideas on how to make the form respond like it does on Windows 7?
- Vivian_TCopper Contributor
Hi, i'm new to thre drag & drop operations.
I'm interrested by using you code.
Can you tell me what I have to do in the form code to make it works ?
Thanks
Best regards,
- tsgiannisIron Contributor
ktesler Something changed in the Windows 10 ecosystem causing this functionality to get problematic...it used to work just fine in Windows 7 but i think we some recent update it tampers with DDH_MAXCALLS and thus the code doesn't work properly...i used to work with something similar in the Windows 7 era and probably early Win 10 editions but later it just doesn't...increasing the DDH_MAXCALLS (i think i saw something like 500) it should help but not much