将文件拖放到 Access 表单中的未绑定超链接框中

Question

我尝试使用 Microsoft Access 表单（当前 Office 365）中的超链接框作为实现文件放置字段的一种解决方法，如 here 所述。我只需要删除文件的路径以供 VBA 代码进一步处理 - 我不需要将值存储到数据库中。因此，我将超链接框切换为未绑定。之后，就不能再删除文件了。

这是设计使然：拖放到超链接框中仅对绑定超链接框启用？

注意：可能与 this question 重复

Answer 1

似乎正在放弃某事。设计师没有考虑到黑洞（未绑定控件）；）

但是您可以使用Adodb.Recordset 创建临时记录集并将其绑定到表单。如果控件绑定到该记录集的某个字段，您可以删除文件（controlsHyperlinkproperty 必须为 true），但没有任何内容存储在内存之外（您可以将临时记录集保存到文件甚至重新连接到表以保存数据）。

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

Answer 2

编辑：这个解决方法被证明是过时的，因为 ComputerVersteher 首先给出的解决方案可以完成这项工作，如果它使用正确 - 我的错。

您可能希望重复使用我的解决方法的以下几行来处理通过删除文件生成的路径：

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

编辑结束

由于之前的答案（至少对我而言）没有解决问题，也许这只能通过解决方法来解决。我已经构建了一个可重用的解决方案，如下所示（示例数据库here）：

(1) 创建一个名为tblDropZone 的表，其中只有一个名为fldLink 的字段为Link。

(2)创建一个名为frmDropZone的表单，将RecordSource设置为tblDropZone；在该表单上创建一个TextBox 控件，将其命名为txtLink 并将其设置为ControlSource 到fldLink。

(3) 创建一个名为frmDropZoneTest 的表单，将frmDropZone 作为子表单sfrmDropZone 放在上面；创建一个未绑定的TextBox 控件，名为txtDropZonePath。

(4) 将以下代码添加到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) 将以下代码添加到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) 化妆品：

• 与frmDropZone
  • 删除txtLink 的标签
  • 根据需要设置txtLink控件的宽度和高度
  • 将txtLink控件移到左上角
  • 设置.NavigationButtons = False
  • 设置.RecordSelectors = False
• 与frmDropZoneTest
  • 调整子窗体控件的Width 和Height 使子窗体的txtLink 控件正好适合。对我来说，它需要比子窗体上的txtLink 控件多约0.01 厘米.
  • 可选设置txtDropZonePath.Visible = False

您可以将sfrmDropZone 复制并粘贴到其他表单，前提是您确保它们都有一个名为txtDropZonePath 的未绑定文本框和一个从子表单的代码txtLink_AfterUpdate() 事件中调用的Public Sub DropZoneWorkaround_Event()，以处理拖放文件的路径。