X   Site Message
(Message will auto close in 2 seconds)

Welcome to UtterAccess! Please ( Login   or   Register )

Custom Search
   Reply to this topicStart new topic
> Drag And Drop Files (feedme), Any Version    
post Sep 15 2011, 12:19 PM

UtterAccess Editor
Posts: 9,880
Joined: 7-December 09
From: Staten Island, NY, USA

There's two demos here. The FeedMe demo is additional functionality to the DragDrop stuff. The DragDrop has the real work in it. The GUI class is required for the FeedMe functoinality. The latest version at the time of this post is included in the FeedMe demo.
This demo shows how to implement dragging and dropping of files from windows explorer into your application.
Included in the zip file is a complete documentation of the DragDrop functionality, starting with simple usage and covering most aspects that the average user might come across.
I've seen two demos of this before: one which utilizes a subform as the "drop area", and one that does not. Myself and at least one other (thanks Alan) experienced problems when attempting to use the drag/drop API functionality in a standalone form: the only way to successfully implement it with the few examples to be found is to setup the drop area as a subform.
The problem is with a callback function from the API that clogs up the VBA project. The callback function required for drog/dropping has to process every system message sent to the window we're using. In the other demos I looked at, hook into the callback is placed when the form is opened and removed when the form is closed. This means that throughout the life of the (standalone) form, that callback is running rather madly: so much that better than 90% of the time it was crashing Access.
When used in a subform, and the hook is placed at the open of the subform and removed at the close of the subform, the behavior is much better. For whatever reason, subform window callbacks do not seem to run unless the mouse is placed over the subform. The general result is a satisfactory implementation of drop/dropping: the subform callbacks are not enough to crash Access. Just don't open the subform as a standalone form, unless you want to crash Access.
When I initially set out to use drag/srop functionality, it was intended to drop a file into a textbox that would enter said file into the system. At the time, I wasn't aware of the subform implementation, and set out to find a way to keep Access from crashing. The solution I came to, the one posted here, works to drop files into a specified control on a standalone form.
The means I used to obtain this was to remove the hooking from the form's open/unload events, and instead have the hook only active while the cursor is over the control that takes the file. This works well as a standalone form implementation, but there is one minor quirk:
The form, either standalone or sub, needs to be registered to accept drag/dropped files. When this form is registered, dragging files anywhere over the form results in the cursor changing from the standard pointer to the dragging icon. This is misleading in the standalone/control implementation as it more or less tells the user that they can drop the files anywhere on the form, but in fact they can only drop them into the control. I cannot think of any workaround to this, but you may or may not view it as a dealbreaker.
In retrospect, using the subform implementation with a sub just large enough to enclose the required control may be a preferable method of handling it: then the user will only see the drag/drop icon in a valid drop area, though loading a subform, depending on how many, will add considerably to the form's load time.
One major advantage to using the MouseOver event to hook into the callback rather than a form's open/close (or load/unload) is that we can now implement drag/drop capabilities one more than one open form at a time. Because the callback needs to be in a standard module, it becomes quite difficult to maintain instancing directives on it. While the message callback does utilizes the form's Handle, I don't know that I'd trust it enough to have two subforms open at once and have the function continuously running and able to keep everything sorted. Using the MouseOver of a control (or the Detail section of a subform) ensures that the callback only has to handle one window at a time.
DragDrop FeedMe
The DragDrop FeedMe demo contains the same drag/drop code as the DragDropAPI demo, but this one has functionality that hides the Access window and pops up a small form so the user can drag files into it without having to work around the Access app or resize it to get files:
The V2 FeedMe includes a class module and demo for it to select a variety of different settings and options. The GUI and modDragDrop modules are required and included in the demo. I haven't done much for documentation on it yet, but there's not really a lot to document on it. The class provides properties and one method, set them as desired, and that's about it.
V2 Demo Snapshot:
Attached File  FeedMe_SS.gif ( 90.88K )Number of downloads: 1095


(please see this post for a minor bug fix where previous files aren't properly cleared - thanks Detire!)
Attached File  DragDrop_v1.0.1_Documentation__Revision_0_.pdf ( 70.01K )Number of downloads: 773
Attached File  DragDrop_v1.0.1.zip ( 132.21K )Number of downloads: 857

Attached File  DragDrop_FeedMe_v2.0.zip ( 96.11K )Number of downloads: 744
Attached File  DragDrop_FeedME_v2.0_Acc2010_32___64bit.zip ( 209.52K )Number of downloads: 688

Older versions:
Attached File  DragDropAPI.zip ( 49.43K )Number of downloads: 360
Attached File  DragDrop_FeedMe.zip ( 33.74K )Number of downloads: 302

Revisions of DragDrop:
'V1.0.1 2011-09-29
'  Modifications from original:
'    - Added link resolution
'    - Added DragDropRemoveDuplicates()
'  Known Bugs
'    - Link resolution doesn't seem to work on
'      some .lnk files.
'      You can modify pfGetShortcutTargets to
'      turn off shortcut target resolution and
'      always return .lnk or .URL files.
Go to the top of the page
post May 13 2015, 02:05 PM

Posts: 3,268
Joined: 19-October 10

Hi all,

I've been talking to Jack about this as I found that it wouldn't allow attachments into a control when the form is a subform. With Jack's permission I have reworked some of the code so that it will be able to work out if a form has a parent (and in turn if that has a parent) and ensure the code still works.

I have added 5 new forms to demonstrate how this nesting works. Select any level and the drag and drop still runs now.
I have noted the code seems to stop working intermittently if you open and close forms in the same session and this is consistently problematic in my revised version and Jack's original version.
I will try to convert this into a class rather than a vanilla module to try to eliminate this problem and allow multiple drop controls on the same form. I will also see if I can do some work to sort out the issue Jack raised about the icon changing on whole form including parents.
Attached File(s)
Attached File  DragDrop_v1.0.2_Demo_A2K.zip ( 35.71K )Number of downloads: 317
Go to the top of the page
post Mar 3 2016, 05:53 PM

Posts: 1
Joined: 3-March 16


I have to change the function to allow it to work in any context in the subform:

Private Function ReturnSubformObject(hWnd As Long, frm As Access.Form) As Access.Form
'Added by Jon smith

On Error GoTo NoSubform

'Dim frm1 As Access.SubForm
'    For Each frm1 In frm
'        If frm1.Form.hWnd = hWnd Then
'            Set ReturnSubformObject = frm1.Form
'            Exit For
'        End If
'        Set ReturnSubformObject = ReturnSubformObject(hWnd, frm1.Form)
'        If Not ReturnSubformObject Is Nothing Then Exit For
'    Next
'Debug.Print "Try finding subform: " & frm.Name

'Change by Jonathan Bilodeau

    Dim ctl As Access.Control
    For Each ctl In frm.Controls
        Debug.Print frm.Name & " " & ctl.Name
        If ctl.Properties("ControlType") = acSubform Then
            If ctl.Form.hWnd = hWnd Then
                Set ReturnSubformObject = ctl.Form
                Exit For
            End If
        End If
    Next ctl
'This code errors if no subform can be found but thats ok as it'll return nothing
End Function

I do not understand why, but that have fix my issue in Access 2010 French feel free to update it as you need.

Go to the top of the page
post Jan 30 2017, 08:31 PM

Posts: 4
Joined: 11-August 16

First let me say I am extremely grateful that you posted this! I wanted to give you credit where it was due smile.gif. On another hand i took it one step further by adding a file import/logging based on the files that were dragged and dropped. I wanted allow a user to drag the files he wanted to add to the database, copy the file to the local server, and then hyperlink to it. This way it is not stored in the database and is extremely easy to use. I know I did not clean up the code for posting, but wanted to share it as everyone else has been more than generous sharing their coding. This script will add on the functionality below;

1. Take files listed in the ctrl box from feed me and log them on another table
2. Take the files and copy them to the folder/server specified

On Error GoTo salah
If txtAttachmentTypeSelection <> "" Then
'DoCmd.RunCommand acCmdSaveRecord '<---- save
'DoCmd.GoToRecord , , acNewRec '<---- new
Dim i As Integer
Dim a As Variant
Dim foldercopy As String
Dim ParentDir As String
Dim REGION As String
Dim Str As String
Dim SAP As String

a = Split(ctlDropBox.Value, vbCrLf)
'MsgBox UBound(a)
For i = 0 To UBound(a)
DoCmd.GoToRecord , , acNewRec '<---- new
txtOriginalFile.Value = a(i)

REGION = TempVars!Regiontxt
Str = TempVars!Strtxt
SAP = TempVars!SAPtxt

If TempVars!WorktypeID = 13 Then
ParentDir = "V:\Server\"

foldercopy = ParentDir & REGION
If Dir(foldercopy, vbDirectory) = "" Then MkDir foldercopy

foldercopy = foldercopy & "\" & SAP
If Dir(foldercopy, vbDirectory) = "" Then MkDir foldercopy

foldercopy = foldercopy & "\" & Str
If Dir(foldercopy, vbDirectory) = "" Then MkDir foldercopy

foldercopy = foldercopy & "\" & Me.txtAttachmentTypeSelection
If Dir(foldercopy, vbDirectory) = "" Then MkDir foldercopy

'foldercopy = "V:\Server\" & REGION & "\" & SAP & "\" & Str & "\" & Me.txtAttachmentTypeSelection
End If
txtDestinationFolder.Value = foldercopy & "\" & Dir(a(i)) ' & "#" & foldercopy & "\" & Dir(a(i))
txtfilename.Value = Left(Dir(a(i)), (InStr(1, Dir(a(i)), ".")) - 1)
txtDateAdded.Value = Date
txtCLPID.Value = TempVars!CLPID
txtAttachmentType.Value = Me.txtAttachmentTypeSelection.Value

'Call FileCopy(OriginalFile.Value, "E:\Test\" & Dir(a(i)))
Dim fso As Object
Set fso = VBA.CreateObject("Scripting.FileSystemObject")
Call fso.CopyFile(txtOriginalFile.Value, foldercopy & "\" & Dir(a(i)))

DoCmd.RunCommand acCmdSaveRecord '<---- save
Next i
MsgBox "Please specify what type of files you are importing in the Attachment Type Dropdown. Thank you!", vbOKOnly + vbExclamation, "Error"
End If

MsgBox "Files have been uploaded!"

Exit Sub
MsgBox Err.Number & " - " & Err.Description
End Sub
Go to the top of the page
post Mar 11 2018, 10:36 PM

Posts: 4
Joined: 11-August 16

FYI this no longer works wit eh most recent update of windows 10. They patched something in their OS that disabled this. Had multiple computer running this code and only the computers with Windows 10 most recent update started failing.
Go to the top of the page

Custom Search
RSSSearch   Top   Lo-Fi    22nd March 2018 - 02:09 PM