DefaultPath = CurrentDb.Path & "\Data\" & DBFileName

 '   тут то что происходит при запуске априкации
 
 '   (вынесено в отдельный модуль для наглядности и удобства)
 
 '============================================================
 

Public Const DBFileName As String = "DB.mdb"   'Константа имени подключемого файла
 
 '(... Public - т.к. используется и тут  и в форме натройки = SetUpProgram)
 

Public Function StartConnection() As Long
 'Функция подключения всего набора внешних данных (какой есть)
 
 'При ошибке возвращает ее код
 
 '(запускается из модуля формы 0Load по таймеру, интервал таймера = 100 (0,1 сек))
 
 '============================================================
 
Dim DefaultPath As String      'Путь к базе по умолчанию
 
Dim str As String              'строка переменного назначения
 
 '=============================================================
 
On Error GoTo StartConnectionErr

 'Получаем путь по умолчанию ( внутри папки откуда запустились)
 
    DefaultPath = CurrentDb.Name & "\Data\" & DBFileName

 'Пытаемся получить заданный путь из INI файла - если не получается то _
 
    применяем и записываем (в INI) путь по умолчанию
    str = ReadINI("Main", "DB Name", DefaultPath)  'см функц. в модуле modReadWriteINI
 

 'Проверяем верен ли полученный из INI файла путь
 
    If Dir(str) = "" Then    'если НЕТ то
 
       str = DefaultPath     'употребляем путь из текущей папки
 
       WriteINI "Main", "DB Path", str  'Запись нового пути в INI файл
 
    End If

 'Подключаем все таблицы из указанного файла
 
    StartConnection = jsConnectAllTables(str)  'см функц. в модуле modDataConnection
 
  
StartConnectionBye:
    Exit Function
    
StartConnectionErr:  '
 
    Debug.Print Err.Description & vbCrLf & " Err#" & Err.Number
    StartConnection = Err.Number
    Err.Clear
    Resume StartConnectionBye
End Function

 'Модуль Записи|Чтения INI файла
 
 '=======================================================================
 
 'Декларация API ......
 
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
    ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" _
    (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Private Function PathToINI() As String
 'Возвращает путь к файлу INI
 
 '=======================================================================
 
Const INI_FileName As String = "Application.ini"
     'PathToINI = App.Path & "\" & INI_FileName             'Для VB
 
    PathToINI = CurrentDb.Name & "\" & INI_FileName   'Для VBA (2000+)
 
End Function


Public Sub WriteINI(sPart As String, sName As String, val As String)
 'Запись данных в INI файл - аргументы:
 
 '   sPart  = Название раздела
 
 '   sName  = Название параметра
 
 '   val    = Значение параметра
 
 '=======================================================================
 
Dim filePath As String
Dim intRet As Integer
On Error GoTo WriteINIErr
 'Получаем путь ....
 
    filePath = PathToINI
 'Пишем значения
 
    intRet = WritePrivateProfileString(sPart, sName, val, filePath)
 'Проверка результата записи
 
    If intRet <>  1  Then  'Неудачное завершение
 
        MsgBox "Процедура WriteINI не смогла записать параметр INI Файла:" & vbCrLf & _
        filePath & vbCrLf & _
        "-----------------------------------------------------------------" & vbCrLf & _
        "[" & sPart & "]" & vbCrLf & sName & "=" & val
    End If
    Exit Sub
WriteINIErr:
    MsgBox "Процедура WriteINI привела к ошибке:" & vbCrLf & _
    "#" & Err.Number & " " & Err.Description, vbCritical
End Sub


Public Function ReadINI(sPart As String, sName As String, Optional DefVal As String = "") As String
 'Чтение данных из файла INI - с возможностью записи значения по умолчанию где аргументы:
 
 '   sPart  = Название раздела
 
 '   sName  = Название параметра
 
 '   DefVal = Значение по умолчанию (на случай его отсутствия)
 
 '=======================================================================
 
 'Значение возвращаемое функцией GetPrivateProfileString если искомое значение параметра не найдено
 
Const strNoValue As String = ""
 '
 
Dim filePath As String    'Путь к INI файлу
 
Dim intRet As Integer     'Длина возвращаемой строки (функцией GetPrivateProfileString)
 
Dim strRet As String      'Возвращаемая строка
 
On Error GoTo ReadINIErr
 'Получаем путь ....
 
    filePath = PathToINI

 'Получаем значение из файла - если его нет будет возвращен 3й аргумент = strNoValue
 
    strRet = String( 255 , Chr( 0 ))
    intRet = GetPrivateProfileString(sPart, sName, strNoValue, strRet,  255 , filePath)
    strRet = Left$(strRet, intRet)

 'Определяем было найдено значение или нет (если возвращено знач. константы strNoValue то = НЕТ)
 
    If strRet = strNoValue Then             'Значение не было найдено
 
        If DefVal <> "" Then                'Если знач по умолчанию задано
 
            WriteINI sPart, sName, DefVal   'Записываем заданное аргументом DefVal значение по умолчанию
 
            strRet = DefVal                 'и возвращаем его же
 
        End If
    End If
 'Возвращаем найденное
 
    ReadINI = strRet
    Exit Function
ReadINIErr:
    MsgBox "Функция ReadINI привела к ошибке:" & vbCrLf & _
    "#" & Err.Number & " " & Err.Description, vbCritical
End Function