Читал. Много думал. Ввел на вызываемой форме-имитаторе гиперлинкдиалога еще одно поле, в которое передаю фокус после апдейта первого (чтобы диалог не циклился).
Полностью осознал ущербность пути, по которому рулил событиями. Но почему папаша Билл не дает мне открыть гиперлинкдиалог в модальном виде? Я был бы ему бесконечно благодарен.
Прикладываю картинку и коды, а то я в посторонних с трудом разбираюсь (свое иногда не могу разобрать).
Суть поведения обновленных псевдогиперлинковых полей (на картинке At1, 2 итд+AnswerRef, которого не видно) такова: по Дблклику вызывается функция, которая смотрит, что за контрол.
1.Если контрол - комбобокс и в нем есть текст, то отправляемся по ссылке Application.FollowHyperlink Path
2.Если это комбобокс и нет ссылки, то смотрим, как зовут контрол
2а - зовут НЕ "IDAnswer" - запускаем обычный FileDialog
2б - если так, то запускаем форму-имитатор PID (не буду расшифровывать, почему такое название)
Поведение в поле IDAnswer отличается именно тем, что аттачменты всегда файлы, а в поле IDAnswer могут заноситься ссылки на директории с перепиской.
3. Если контрол - текстбокс, то выполняется файл-диалог с решетками, т.к. все такие текстбоксы у меня - гиперлинки (осталось немного в других таблицах)
В всех случаях если выбраный файл/папка - новый, то функция DestFileID вставляет строку в таблицу-справочник.
Щас ошибок найдем и раскритикуем. Велькам
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
Public Function FileDialogDblClick() As Boolean
Dim fd As FileDialog, CntrlType As Integer, i As Long
Dim str As String, Path As String
Dim FormPID As Form
On Error Resume Next
CntrlType = Application.Screen.ActiveControl.Properties("ControlType")
Select Case CntrlType
Case 111 'Случай комбобокса
If Application.Screen.ActiveControl = 1 Or IsNull(Application.Screen.ActiveControl) Then
If Application.Screen.ActiveControl.Name <> "IDAnswer" Then
Set fd = Application.FileDialog(msoFileDialogFilePicker)
If (fd.Show = - 1 ) Then
str = fd.SelectedItems( 1 )
Application.Screen.ActiveControl = DestFileID(str) ' Проверяем, заносим новый путь в справочник
End If
Else
Set FormPID = New Form_PID
DoCmd.OpenForm FormPID
Set FormPID = Nothing
End If
Else
'Если ссылка уже есть (в комбо число > 1), то идем по ссылке
Path = Application.Screen.ActiveControl.Column( 0 )
Application.FollowHyperlink Path
End If
Case 109 'Случай текстбокса
Set fd = Application.FileDialog(msoFileDialogFilePicker)
If (fd.Show = - 1 ) Then
str = fd.SelectedItems( 1 )
Application.Screen.ActiveControl = str & "#" & str & "#"
i = DestFileID(str) 'Проверяем, заносим новый путь в справочник (если надо)
End If
Case Else
MsgBox "Неизвестный тип контрола"
End Select
End Function
Public Function DestFileID(Path As String) As Long
Dim rst As DAO.Recordset, SQLString As String
repeat:
SQLString = "SELECT DestFiles.FileID FROM DestFiles WHERE [FilePath]=" & "'" & Path & "';"
Set rst = CurrentDb.OpenRecordset(SQLString)
If rst.RecordCount = 0 Then
DoCmd.SetWarnings False
SQLString = "INSERT INTO DestFiles(FilePath) SELECT '" & Path & "' AS Expr1;"
DoCmd.RunSQL (SQLString)
DoCmd.SetWarnings True
GoTo repeat
Else
DestFileID = rst( 0 )
End If
End Function
Форма PID
Option Compare Database
Private Sub HyperAnswer_AfterUpdate()
Dim str As String
str = HyperlinkPart(Me.HyperAnswer, acAddress)
str = Replace(str, "..", "O:")
str = Replace(str, "/", "\")
Forms!MailLists.Child6.Form.IDAnswer = DestFileID(str)
Forms!MailLists.Child6.Form.IDAnswer.Requery
Forms!MailLists.Child6.Form.IDAnswer.Text = str
Me.Refresh
Me.Vspom.SetFocus
End Sub
Private Sub HyperAnswer_GotFocus()
On Error Resume Next
DoCmd.RunCommand acCmdEditHyperlink
Exit Sub
End Sub
