'Пример использования:
' WriteINI "Настройка Приложения", "Путь к БАЗЕ", CurrentProject.Path
' MsgBox ReadINI("Настройка Приложения", "Путь к БАЗЕ", "НЕ ЗНАЮ! :(")
Option Explicit
'=======================================================================
'js 20.11.03
'Модуль Записи|Чтения 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 = "KConfig.ini"
'PathToINI = App.Path & "\" & INI_FileName Для VB
PathToINI = CurrentProject.Path & "\" & 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
Public Sub wrini()
WriteINI "Другая настройка", "ЕщеПуть к БАЗЕ", CurrentProject.Path
MsgBox ReadINI("Настройка Приложения", "Путь к БАЗЕ")
End Sub
Вот таак хотя бы, но можно и круче