-Поиск по дневнику

Поиск сообщений в rss_sql_ru_access_programming

 -Подписка по e-mail

 

 -Постоянные читатели

 -Статистика

Статистика LiveInternet.ru: показано количество хитов и посетителей
Создан: 16.03.2006
Записей:
Комментариев:
Написано: 4


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


 

Добавить комментарий:
Текст комментария: смайлики

Проверка орфографии: (найти ошибки)

Прикрепить картинку:

 Переводить URL в ссылку
 Подписаться на комментарии
 Подписать картинку