перетащите файл в поле с несвязанной гиперссылкой в ​​форме доступа

Question

Я пытаюсь использовать поле с гиперссылкой в ​​форме Microsoft Access (текущий Office 365) как своего рода обходной путь для реализации поля удаления файла, как описано здесь . Мне нужен только путь отброшенного файла для дальнейшей обработки кодом VBA - мне не нужно сохранять значение в базе данных. Поэтому я переключил окно гиперссылки на unbound. После этого удаление файла больше невозможно.

Это сделано специально: перетаскивание в поле гиперссылки доступно только для связанных полей гиперссылки?

Примечание: возможно, дубликат этого вопроса

Answer 1

Кажется, упав чтобы черная дыра (несвязанный элемент управления) не рассматривалась дизайнерами;)

Но вы можете создать временные наборы записей с помощью Adodb.Recordset и связать их с формой. Если элемент управления связан с полем этого набора записей, вы можете удалить файлы (свойство controls Hyperlink должно иметь значение 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

Конец редактирования

Поскольку предыдущий ответ (по крайней мере, для меня) не решил проблему, возможно, это может быть решено только обходным путем. Я построил многоразовое решение следующим образом (пример базы данных здесь ):

(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
  • set txtLink Ширина и высота элемента управления по мере необходимости
  • переместить txtLink элемент управления в верхний левый угол
  • установить .NavigationButtons = False
  • установить .RecordSelectors = False
• С помощью frmDropZoneTest
  • отрегулируйте Width и Height элемента управления подчиненной формы так, чтобы точно соответствовал элемент управления txtLink подчиненной формы. Для меня это должно было быть около 0,01 см больше, чем txtLink элемент управления в подчиненной форме.
  • необязательный набор txtDropZonePath.Visible = False

Вы можете скопировать и вставить sfrmDropZone в другие формы, если вы должны убедиться, что у них всех есть несвязанный TextBox с именем txtDropZonePath и Public Sub DropZoneWorkaround_Event(), вызываемый из события кода txtLink_AfterUpdate() подчиненной формы для обработки пути удаленного файла.