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.