GetOpenFileName для 64 битного Access
|
|
Воскресенье, 31 Июля 2016 г. 18:52
+ в цитатник
Господа приветствую.
нарвался и я на Access 64бит...
Ранее хорошо работавшая API на 32/64 оси и 32Access перестала компилироваться в 64Access
Объявляю:
+ |
#If Win64 Then
#If VBA7 Then
Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As LongPtr
#Else
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As LongPtr
#End If
Public Type OPENFILENAME
lStructSize As LongPtr
hWndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As LongPtr
nMaxCustrFilter As LongPtr
nFilterIndex As LongPtr
lpstrFile As String
nMaxFile As LongPtr
lpstrFileTitle As String
nMaxFileTitle As LongPtr
lpstrInitialDir As String
lpstrTitle As String
flags As LongLong
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustrData As LongPtr
lpfnHook As LongPtr
lpTemplateName As LongPtr
End Type
#Else
#If VBA7 Then
Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
#Else
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias _
"GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
#End If
Public Type OPENFILENAME
lStructSize As Long
hWndOwner As Long
hInstance As Long
lpstrFilter As String
lpstrCustomFilter As Long
nMaxCustrFilter 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
lCustrData As Long
lpfnHook As Long
lpTemplateName As Long
End Type
#End If
Public Const OFN_ALLOWMULTISELECT = &H200
Public Const OFN_CREATEPROMPT = &H2000
Public Const OFN_EXPLORER = &H80000
Public Const OFN_FILEMUSTEXIST = &H1000
Public Const OFN_HIDEREADONLY = &H4
Public Const OFN_NOCHANGEDIR = &H8
Public Const OFN_NODEREFERENCELINKS = &H100000
Public Const OFN_NONETWORKBUTTON = &H20000
Public Const OFN_NOREADONLYRETURN = &H8000
Public Const OFN_NOVALIDATE = &H100
Public Const OFN_OVERWRITEPROMPT = &H2
Public Const OFN_PATHMUSTEXIST = &H800
Public Const OFN_READONLY = &H1
Public Const OFN_SHOWHELP = &H10
|
использую: тут и выпадает
+ |
Public Function OpenFile(ByVal InitDir As String, ByVal fName As String, _
Optional ByVal strExt As String, Optional das As String, Optional blMultiSelect As Boolean = False) As String
' InitDir- можно установить адрес папки - от куда открывать окно поиска
' fname - можно назначить имя файла для фильтрации видимых имен
' strExt - установка фильтра
' das - установка фильтра расширений файлов
' blMultiSelect - возможность выбора одного/нескольких файлов
'Dim strFile As String * 512
Dim of As OPENFILENAME
'Dim f As String
Dim p%
On Error GoTo OpenFile_Error
' Установка начальных значений структуры
'.hwndOwner = Application.hWndAccessApp - переписал строку кодом ниже
#If Win64 Then
' здесь бьет ошибку - метод или член данных не найден
of.hWndOwner = Application.HWND32
#Else
of.hWndOwner = Application.hWndAccessApp
#End If
of.hInstance = 0
of.lpstrCustomFilter = 0
of.nMaxCustrFilter = 0
of.lpfnHook = 0
of.lpTemplateName = 0
of.lCustrData = 0
of.lpstrFilter = das & Chr$(0) & Chr$(0)
of.nFilterIndex = 3
#If Win64 Then
of.nMaxFile = LenB(of.lpstrFile) - 1
of.lStructSize = LenB(of)
of.nMaxFileTitle = LenB(of.lpstrFile) - 1
#Else
of.nMaxFile = 511
of.nMaxFileTitle = 511
#End If
of.lpstrFile = fName & String$(512 - Len(fName), 0)
of.lpstrFileTitle = String$(512, 0)
' Ниже вы можете изменить заголовок окна
of.lpstrTitle = "Поиск файла данных: " & fName
of.lpstrInitialDir = InitDir
'Ниже вы можете изменить фильтры для поиска файлов
of.lpstrDefExt = strExt
If blMultiSelect = True Then
of.flags = OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST + OFN_ALLOWMULTISELECT + OFN_EXPLORER
Else
of.flags = OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST
End If
of.lStructSize = Len(of)
If GetOpenFileName(of) Then
If blMultiSelect = False Then
p% = InStr(1, of.lpstrFile, Chr$(0))
OpenFile = Left(of.lpstrFile, p% - 1)
Else
p% = InStr(1, of.lpstrFile, Chr$(0) & Chr$(0))
OpenFile = Left(of.lpstrFile, p% + 1)
End If
Else
OpenFile = ""
End If
On Error GoTo 0
Exit Function
OpenFile_Error:
' If LogError(Err.Number, Err.Description, Erl, "OpenFile", "OpenFiles", "") = True Then
' Call ErrorLogFunct
' Else
MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure OpenFile of OpenFiles", , "Error!"
' End If
End Function
|
В коде описал, где спотыкается. Скрин еще приложил.
Сказать бы пронесло - поговорил с человеком, он переставился на 32битный.
Но, первый раз, не означает, что он же и последний.
искал варианты в облаке, видел несколько описаний и они все разные. Проблема в попробовать любой из них.
У меня нет возможности себе поставить это счастье.
Клиенту во время обсуждения несколько раз намекал, на попасть к нему на машину и "проверить" работу кода. Но согласия так и не получил...
Получилось как то все дистанционно...
Господа, у кого есть опыт работы с GetOpenFileName в 64битн Access, напишите, как переписать те строки, что связаны с битностью в самой функции..
Была бы у меня возможность, сам бы игрался...да нет возможности себе поставить
http://www.sql.ru/forum/1224880/getopenfilename-dlya-64-bitnogo-access
-
Запись понравилась
-
0
Процитировали
-
0
Сохранили
-