VBA, MS Access MS Access в примерах

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

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


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

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

Сам модуль:


'--------------------------------------------------------------------
' Module    : modINI
' Author    : es
' Date      : 07.01.2004 - 07.02.2019 LE
' 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

'Получаем значение из файла - если его нет будет возвращен 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 sDefaultValue <> "" Then               'Если знач по умолчанию задано
            INIWrite sName, sDefaultValue, sPart  'Записываем заданное аргументом DefVal значение по умолчанию
            strRet = sDefaultValue                'и возвращаем его же
        End If
    End If
'Возвращаем найденное
    INIRead = strRet
    Exit Function
INIReadErr:
    MsgBox "Функция INIRead привела к ошибке:" & vbCrLf & _
    "#" & Err.Number & " " & Err.Description, vbCritical
End Function




Назад ToTop
L.E. 19.03.2023
Рейтинг@Mail.ru