Настройки - Работа с INI файлом локальных настроек приложения (API)

Создаём , пишем и читaем INI файл в формате:
[Имя раздела]
Название параметра = Значение параметра

Пример использования:

Private Sub INITest()
'Пишем: Назв_Параметра , Знач_Параметра, Назв_Наздела
    INIWrite "Путь к БАЗЕ", CurrentProject.Path, "Настройка Приложения"
'Читаем: Назв_Параметра, Знач_Параметра_по_Умолчанию, Назв_Наздела
    MsgBox INIRead("Путь к БАЗЕ", "НЕ ЗНАЮ!", "Настройка Приложения")
End Sub

Сам модуль:

'--------------------------------------------------------------------
' Module    : modINI
' Author    : es
' Date      : 07.01.2004 - LE 14.10.2024 v05
' Purpose   : Модуль Записи - Чтения INI файла локальных настроек приложения
'             Файл создаётся в папке приложения - автоматом (при первом обращении)
'--------------------------------------------------------------------
Option Compare Database
Option Explicit

'Сразу задаём название файла (Будет в папке приложения)
Private Const INIFileName As String = "Application.ini"
'--------------------------------------------------------------------
'Декларация API ......

#If VBA7 Then
    Private Declare PtrSafe 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 PtrSafe Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, _
        ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
#Else
    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
#End If
'--------------------------------------------------------------------

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


Public Function INIRead(sName As String, Optional sDefaultValue As String = "", Optional sPart As String = "Settings") As String
'Чтение данных из файла INI - с возможностью записи значения по умолчанию где аргументы:
'   sName          = Название параметра
'   sDefaultValue  = Значение по умолчанию (на случай его отсутствия)
'   sPart          = Название раздела
'--------------------------------------------------------------------
'Значение возвращаемое функцией GetPrivateProfileString если искомое значение параметра не найдено
Const strNoValue As String = ""
Dim FilePath As String   'Путь к INI файлу
Dim intRet As Integer    'Длина возвращаемой строки (функцией GetPrivateProfileString)
Dim strRet As String     'Возвращаемая строка
On Error GoTo INIReadErr
'Получаем путь ....
    FilePath = CurrentProject.Path & "\" & INIFileName
' Если файла нет - создаём в нужном формате и разметке (опционально)
'   INICheckAndCreate strINIFilePath ' опционально - для красоты INI файла
'Получаем значение из файла - если его нет будет возвращен 3й аргумент = strNoValue
    strRet = String(255, Chr(0))
    intRet = GetPrivateProfileString(sPart, sName, strNoValue, strRet, 255, FilePath)
    strRet = Left$(strRet, intRet)

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

Дополнительно:

Private Sub INICheckAndCreate(strFilePath$)
' Создаёт пустой новый файл INI с заданной разметкой разделов (опционально - для красоты INI файла)
'---------------------------------------------------------------------------------------------------/
Dim objADODBStream As Object
'Dim objADODBStream As New ADODB.Stream
Const csNewEmptyText$ = "[Settings]" & vbCrLf & vbCrLf & _
                        "[SQL Server Connection Settings 00]" & vbCrLf & vbCrLf & _
                        "[SQL Server Connection Settings 01]" & vbCrLf & vbCrLf & _
                        "[SQL Server Connection Settings 02]"
'---------------------------------------------------------------------------------------------------/
    If Dir(strFilePath, vbNormal) = "" Then
        ' Если объявлено как Object
        If objADODBStream Is Nothing Then Set objADODBStream = CreateObject("ADODB.Stream")
        With objADODBStream
            .Type = 2: .Charset = "Windows-1251": .Open
            .WriteText csNewEmptyText
            .SaveToFile strFilePath, 2
            .Close
        End With
        DoEvents
        Set objADODBStream = Nothing
    End If
End Sub