Решил поднять старую ветку, чтоб не создавать новую.
Проблема: диалог выбора для открытия файла при помощи WinAPI. Вот текст чисто для 64-х битной версии офиса
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.
79.
80.
81.
82.
83.
Option Compare Database
Option Explicit
Type OPENFILENAME
lStructSize As Long
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As Long
nFilterIndex As Long
lpstrFile As String
nMaxFile As Long
lpstrFileTitle As String
nMaxFileTitle As Long
lpstrInitialDir As String
lpstrTitle As String
flags As Long
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As LongPtr
lpfnHook As LongPtr
lpTemplateName As String
'#if (_WIN32_WINNT >= 0x0500)
pvReserved As LongPtr
dwReserved As Long
FlagsEx As Long
'#endif // (_WIN32_WINNT >= 0x0500)
End Type
Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
'---------------------------------------------------------------------------------------
' Procedure : GetDBFileNameDlg
' DateTime : 19.01.2007 10:25
' Author : DSonnyh
' Purpose : Диалог задания пути к подключаемой базе MDB
'---------------------------------------------------------------------------------------
'
Public Function GetDBFileNameDlg64(hWn As Long, fName As String) As Integer
On Error GoTo Err_
Dim l As Long
Dim pOpenfilename As OPENFILENAME
Dim strPatchFi As String
Dim strFolderName As String
GetDBFileNameDlg64 = False
pOpenfilename.lStructSize = Len(pOpenfilename)
pOpenfilename.lpstrFilter = "*.mdb" + Chr(0) + "*.mdb" + Chr(0) + "*.*" + Chr(0) + "*.*" + Chr(0) + Chr(0)
pOpenfilename.lpstrFile = String(255, Chr(0))
pOpenfilename.nMaxFile = 255
pOpenfilename.lpstrTitle = "Выберите файл с таблицами базы данных"
pOpenfilename.hwndOwner = hWn
pOpenfilename.lpstrInitialDir = fName
l = GetOpenFileName(pOpenfilename)
If l <> 0 Then
fName = pOpenfilename.lpstrFile
GetDBFileNameDlg64 = True
End If
Exit_:
Exit Function
Err_:
MsgBox Err.Description
Resume Exit_
End Function
' =======================================================
Public Sub testfo()
Dim strPath As String
Dim i As Long
strPath = "C:\"
i = GetDBFileNameDlg64(0, strPath)
End Sub
Запускаешь testfo() и смотришь под отладчиком. В строке
1.
l = GetOpenFileName(pOpenfilename)
просто не происходит вызов диалога выбора файла. Программа просто проскакивает дальше без всяких сообщений.
А вот вариант АлексеяЕ работает прекрасно
1.
2.
3.
4.
5.
6.
7.
Public Sub test_dialog2()
Dim strFile As String, strFilter As String
strFilter = "MS Access Database (*.mdb)|*.mdb|Add-ins (*.mda)|*.mda|MDE-Files (*.mde)|*.mde|All Files (*.*)|*.*||"
WizHook.Key = 51488399
WizHook.GetFileName 0, "AppName", "DlgTitle", "", strFile, "c:\", strFilter, 0, 0, 0, True
MsgBox strFile
End Sub
Да и вариант
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
Public Sub dialog1()
Dim dlgOpenFile As Object ' FileDialog
Dim strFile As String
Set dlgOpenFile = Application.FileDialog(1)
With dlgOpenFile
.Filters.Clear
.InitialFileName = CurrentProject.Path
.AllowMultiSelect = False
.Title = "ëÿëÿëÿ"
If (.Show = -1) And (.SelectedItems.Count > 0) Then
strFile = .SelectedItems(1)
End If
End With
Set dlgOpenFile = Nothing
End Sub
работает нормально.
А вот WinAPI в 64-х битной версии Access запускаться не хочет. Кто знает, в чём дело?
