аналог OpenDialog

[borg]

господа есть ли в vba аналог Дельфийского компонента OpenDialog?
смысл в том, что мне нужно сделать удобный интерфейс открытия файла в БД Access
Заранее благодарен

[xolod]

Common Dialog Control ?

[borg]

отвечать вопросом на вопрос в данной ситуации
странно, я в vba новичок)

[A.A.Z.]

Project->Components->Microsoft Common Dialog Control

[ism]

Project->Components->Microsoft Common Dialog Control

но приэтом придется с программой таскать comdlg32.ocx (он около мега), легче использовать для вызова открытия этот модуль:

Код: Выделить всё

Option Explicit 'Чтоб все объявить явно

Public Enum ofnflags 'Флаги API GetOpenFileName
OFN_ALLOWMULTISELECT = &H200
OFN_CREATEPROMPT = &H2000
OFN_ENABLEHOOK = &H20
OFN_ENABLETEMPLATE = &H40
OFN_ENABLETEMPLATEHANDLE = &H80
OFN_EXPLORER = &H80000                         '  new look commdlg
OFN_EXTENSIONDIFFERENT = &H400
OFN_FILEMUSTEXIST = &H1000
OFN_HIDEREADONLY = &H4
OFN_LONGNAMES = &H200000                       '  force long names for 3.x modules
OFN_NOCHANGEDIR = &H8
OFN_NODEREFERENCELINKS = &H100000
OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
OFN_NONETWORKBUTTON = &H20000
OFN_NOREADONLYRETURN = &H8000
OFN_NOTESTFILECREATE = &H10000
OFN_NOVALIDATE = &H100
OFN_OVERWRITEPROMPT = &H2
OFN_PATHMUSTEXIST = &H800
OFN_READONLY = &H1
OFN_SHAREAWARE = &H4000
OFN_SHAREFALLTHROUGH = 2
OFN_SHARENOWARN = 1
OFN_SHAREWARN = 0
OFN_SHOWHELP = &H10
End Enum

Private Type OPENFILENAME 'Структура для API GetOpenFileName
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    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 Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long

Public Function opendlg(hwnd As Long, Filter As String, FilterIndex As Long, FileName As String, DefaultExt As String, InitDir As String, DialogTitle As String, flags As ofnflags) As String
'Функция вызывает окно выбора файла, возвращает выбранный файл (или пустую строку в случае отмены)
Dim iDelim As Long
Dim OFN As OPENFILENAME 'Структура для API GetOpenFileName
Dim sTemp As String
Dim i As Integer
Dim retval As Long 'Значение возвращаемое самой API

  flags = flags And (&H1 Or &H2 Or &H4 Or &H8 Or &H10 Or &H100 Or &H200 Or &H400 Or &H800 Or &H1000 Or &H2000 Or &H4000 Or &H8000 Or &H40000 Or &H80000 Or &H100000 Or &H200000) 'Эти флаги не должны стоять в открытии, сбросить их

  With OFN
        'Длинны структуры
       .lStructSize = Len(OFN)
       'Дескриптор окна
       .hwndOwner = hwnd
       'Коментарии излишни, флаги
       .flags = flags
       'Расширение по умолчанию, тоже нужно хоть и открытие :-(
       .lpstrDefExt = DefaultExt
       sTemp = InitDir
       'Если не выбрана парка то папка с прогой
       If sTemp = "" Then sTemp = App.Path
       .lpstrInitialDir = sTemp
       sTemp = FileName
       'Все заполнить символом chr(0). Надо!
       .lpstrFile = sTemp & String$(255 - Len(sTemp), 0)
       .nMaxFile = 255
       .lpstrFileTitle = String$(255, 0)
       .nMaxFileTitle = 255
        sTemp = Filter
        'Чтоб ни мучится с выписыванием chr(0) в вызов ф-ии
        For i = 1 To Len(sTemp)
            If Mid(sTemp, i, 1) = "|" Then
               Mid(sTemp, i, 1) = vbNullChar
            End If
        Next
        sTemp = sTemp & String$(2, 0)
        .lpstrFilter = sTemp
        .nFilterIndex = FilterIndex
        .lpstrTitle = DialogTitle
        .hInstance = App.hInstance
End With

'Вызов API
retval = GetOpenFileName(OFN)
'А все ли ОК?
If retval = 0 Then
opendlg = ""
Else
    'первый символ chr(0)
     iDelim = InStr(OFN.lpstrFile, vbNullChar)
     'Удалить лишнии chr(0)
     If iDelim Then opendlg = Left$(OFN.lpstrFile, iDelim - 1)
End If
End Function