drop file into unbound hyperlink box in Access form

user_1349511 0
Viewed 611

I try to use a hyperlink box in a Microsoft Access form (current Office 365) as kind of a workaround for implementing a file drop field as described here. I only need the path of the dropped file for further processing by VBA code - I do not need to store the value into the database. Therefore I switched the hyperlink box to unbound. After that, dropping a file is not possible any more.

Is this by design: drag and drop into a hyperlink box is only enabled for bound hyperlink boxes?

Note: possibly duplicate of this question

ms-access vba
2 Answers

Seems dropping sth. to a black hole (unbound control) wasn't considered by designers ;)

But you can create temporary recordsets withAdodb.Recordsetand bind it to a form. If control is bound to a field of that recordset, you can drop files (controlsHyperlinkproperty needs to be true) , but nothing is stored outside memory (you can save the temporary recordset to a file or even reconnect to tables to save data).

Private Sub Form_Load()
    Dim rs As Object 'ADODB.Recordset
    Set rs = CreateObject("ADODB.Recordset")  'New ADODB.Recordset

    With rs
        Const adLongVarChar As Long = 201
        .Fields.Append "Hyperlink", adLongVarChar, 2000 ' create field to bind to control
        Const adUseClient As Long = 3
        .CursorLocation = adUseClient 'needed to make rs editable, when bound to form
        Const adOpenDynamic As Long = 2
        Const adLockOptimistic As Long = 3
        .Open , , adOpenDynamic, adLockOptimistic, 8

        .AddNew 'create one record to store link
        .Fields("Hyperlink").value = ""
        .Update
    End With
    Set Me.Recordset = rs
    Me("controlName").ControlSource = "Hyperlink" ' bind textbox to rs field
End Sub
user_94393300

Edit: This workaround turned out to be obsolete as the solution first given by ComputerVersteher does the job, if it's used correctly - my fault.

You may want to re-use the following lines of my workaround to process the path generated by dropping a file:

Dim sPath As String
sPath = Me.txtLink.Hyperlink.Address
    ' NOTE: Hyperlink.Address returns '..\..\..' relative to database location
    '  =>   (a) add current project path
    '       (b) use FileSystemObject to get full qualified path
sPath = CurrentProject.Path & "\" & sPath
sPath = CreateObject("Scripting.FileSystemObject").GetFile(sPath).Path

End of edit

As the previous answer (at least for me) didn't solve the problem maybe this can only be adressed by a workaround. I've build a reusable solution as follows (sample database here):

(1) Create a table called tblDropZone with only one field named fldLink of type Link.

(2) Create a form called frmDropZone, set RecordSource to tblDropZone; create a TextBox control on that form, name it txtLink and set it's ControlSource to fldLink.

(3) Create a form called frmDropZoneTest, put frmDropZone on it as subform sfrmDropZone; create an unbound TextBox control called txtDropZonePath.

(4) Add the following code to frmDropZone:

Option Compare Database
Option Explicit

Const mcsParentControlName As String = "txtDropZonePath"
' note: change here if name of control in master form changed!


Private Sub Form_Load()
    Me.Recordset.AddNew
End Sub


Private Sub txtLink_AfterUpdate()
    Dim sPath As String
    sPath = Me.txtLink.Hyperlink.Address
        ' NOTE: Hyperlink.Address returns '..\..\..' relative to database location
        '  =>   (a) add current project path
        '       (b) use FileSystemObject to get full qualified path
    sPath = CurrentProject.Path & "\" & sPath
    sPath = CreateObject("Scripting.FileSystemObject").GetFile(sPath).Path

    ' empty "drop zone"-control and cancel record edit
    Me.txtLink = Null
    Me.Undo

    ' if used as subform then
    '   (1) write value to parent form's control as defined in constant
    '   (2) call event handler in parent form 
    '       note: the AfterUpdate of the parent form's control does not fire 
    '             on control's value change by code
    If HasParent(Me) Then
        Me.Parent.Controls(mcsParentControlName).Value = sPath
            ' you may want to add some error handling on this
        Me.Parent.DropZoneWorkaround_Event 
            ' this has to be a public sub in parent form code
            ' you may want to add some error handling on this
    End If
End Sub


Private Function HasParent(F As Object) As Boolean
    'https://stackoverflow.com/a/57884609/1349511
    'Inspired from: https://access-programmers.co.uk/forums/showthread.php?t=293282   @Sep 10th, 2019
    Dim bHasParent As Boolean
    On Error GoTo noParents

    bHasParent = Not (F.Parent Is Nothing)
    HasParent = True
    Exit Function

noParents:
   HasParent = False
End Function

(5) Add the following code to frmDropZoneTest:

Option Compare Database
Option Explicit

' unbound TextBox 'txtDropZonePath' will be filled by subform 'frmDropZone'
' NOTES:
'   define name of this TextBox as constant in subform code
'   public sub as event handler needed (called from subform)

Private Sub txtDropZonePath_AfterUpdate()
    Debug.Print "Path: " & txtDropZonePath
End Sub

Public Sub DropZoneWorkaround_Event()
    txtDropZonePath_AfterUpdate
End Sub

(6) Cosmetics:

  • With frmDropZone
    • remove label for txtLink
    • set txtLink control's Width and Height as needed
    • move txtLink control to the upper left corner
    • set .NavigationButtons = False
    • set .RecordSelectors = False
  • With frmDropZoneTest
    • adjust the subform control's Width and Height so that exactly the txtLink control of the subform fits in. For me, it needed to be about 0,01 cm more than the txtLink control on the subform.
    • optional set txtDropZonePath.Visible = False

You can copy and paste sfrmDropZone to other forms if you make sure they all have an unbound TextBox called txtDropZonePath and a Public Sub DropZoneWorkaround_Event() to be called from the subform's code txtLink_AfterUpdate() event, to handle the dropped file's path.

user_13495110
Related