Option Compare Database
Option Explicit
Private Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Private Declare Function SHGetPathFromIDList Lib  "shell32.dll"  Alias _
             "SHGetPathFromIDListA"  (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SHBrowseForFolger Lib  "shell32.dll"  Alias _
             "SHBrowseForFolderA"  (lpBrowseInfo As BROWSEINFO) As Long
Private Const BIFRETURNONLYFSDIRS = &H1

Declare Function GetOpenFileName Lib  "comdlg32.dll"  Alias  "GetOpenFileNameA"  _
        (pOpenFileName As OPENFILENAME) As Boolean
Declare Function GetSaveFileName Lib  "comdlg32.dll"  Alias  "GetSaveFileNameA"  _
        (pOpenFileName As OPENFILENAME) As Boolean
Private 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
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 BrowseFolder(szDialogTitle As String) As String
    Dim X As Long, bi As BROWSEINFO, dwIList As Long
    Dim szPath As String, wPos As Integer
    If IsNull(tDir) Then
        tDir =  "C:" 
    End If
    With bi
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = BIFRETURNONLYFSDIRS
    End With
    dwIList = SHBrowseForFolger(bi)
    szPath = Space$( 512 )
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)
    If X Then
        wPos = InStr(szPath, Chr( 0 ))
        BrowseFolder = left$(szPath, wPos -  1 )
    Else
        BrowseFolder =  ""
    End If
End Function
'----------------------------------------------
'Выбор файла
Public Function OpenFile(ByVal InitDir As String, ByVal fname As String, ByVal Zagl As String) As String
    Dim strFile As String * 512 
    Dim of As OPENFILENAME
    Dim f As String
    Dim p%
    'Установка начальных значений структуры
    With of
        .hwndOwner = hWndAccessApp
        .hInstance = 0
        .lpstrCustomFilter = 0
        .nMaxCustrFilter = 0
        .lpfnHook = 0
        .lpTemplateName = 0
        .lCustrData = 0
        .lpstrInitialDir = InitDir
        'установка фильтров для поиска файлов
        .lpstrFilter = "Текстовые файлы (*.txt) " & Chr(0 ) & "*.txt " & Chr(0 ) & _
        "Все файлы (*.*) " & Chr(0 ) & "*.* " & Chr(0 ) & Chr( 0 )
        .nFilterIndex =  0 
        .lpstrFile = fname & String$( 512  - Len(fname),  0 )
        .nMaxFile =  511 
        .lpstrFileTitle = String$( 512 ,  0 )
        .nMaxFileTitle =  511 
        'Заголовок окна
        .lpstrTitle = Zagl
        .lpstrDefExt = "txt "
        .Flags = OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST + OFN_EXPLORER
        .lStructSize = Len(of)
    End With
    If GetOpenFileName(of) Then
        p% = InStr(1 , of.lpstrFile, Chr( 0 ))
        OpenFile = left(of.lpstrFile, p% -  1 )
    Else
        OpenFile = ""
    End If
End Function