VBA – Leer Escribir archivos INI

Mirando a través de una antigua base de datos que había creado, me encontré con algún código que había reunido hace un tiempo para leer y escribir archivos INI.

Si ha buscado un poco en línea, estoy seguro de que ha encontrado API como la función GetPrivateProfilEntring, que puede usarse para hacer esto, pero por mucho que pueda, trato de minimizar mi uso de ActiveX y API y este es un caso en el que no se requiere una API para realizar una búsqueda y escritura básicas de texto.

A medida que pasó el tiempo, también aprendí el valor de usar archivos INI para almacenar las preferencias de los usuarios. Si bien es posible almacenar dichos datos en la base de datos front-end, se pierde al actualizar. Otra opción sería usar el registro, pero no me gusta usar el registro, excepto la información de registro y los gustos. Más allá de lo cual, no puedo ser fácilmente empujado a una nueva computadora. Al usar un archivo INI simple, puede almacenar cualquier información que elija, permanece intacta cuando las actualizaciones se realizan y se pueden transferir con gran facilidad a otras computadoras para que el usuario pueda retener su configuración.

Trabajar con archivos INI usando VBA puro

Suficiente con la charla, a continuación se encuentran las funciones involucradas.

Public bSectionExists         As Boolean
Public bKeyExists             As Boolean

'---------------------------------------------------------------------------------------
' Procedure : Ini_ReadKeyVal
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' Purpose   : Read an Ini file's Key
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - 
' Req'd Refs: Uses Late Binding, so none required
'             No APIs either! 100% VBA
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sIniFile  : Full path and filename of the ini file to read
' sSection  : Ini Section to search for the Key to read the Key from
' sKey      : Name of the Key to read the value of
'
' Usage:
' ~~~~~~
' ? Ini_Read(Application.CurrentProject.Path & "\MyIniFile.ini", "LINKED TABLES", "Path")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2012-08-09              Initial Release
' 2         2025-06-03              Updated Copyright.
'---------------------------------------------------------------------------------------
Function Ini_ReadKeyVal(ByVal sIniFile As String, _
                        ByVal sSection As String, _
                        ByVal sKey As String) As String
    On Error GoTo Error_Handler
    Dim sIniFileContent       As String
    Dim aIniLines()           As String
    Dim sLine                 As String
    Dim i                     As Long

    sIniFileContent = ""
    bSectionExists = False
    bKeyExists = False

    'Validate that the file actually exists
    If FileExist(sIniFile) = False Then
        MsgBox "The specified ini file: " & vbCrLf & vbCrLf & _
               sIniFile & vbCrLf & vbCrLf & _
               "could not be found.", vbCritical + vbOKOnly, "File not found"
        GoTo Error_Handler_Exit
    End If

    sIniFileContent = ReadFile(sIniFile)    'Read the file into memory
    aIniLines = Split(sIniFileContent, vbCrLf)
    For i = 0 To UBound(aIniLines)
        sLine = Trim(aIniLines(i))
        If bSectionExists = True And Left(sLine, 1) = "(" And Right(sLine, 1) = ")" Then
            Exit For    'Start of a new section
        End If
        If sLine = "(" & sSection & ")" Then
            bSectionExists = True
        End If
        If bSectionExists = True Then
            If Len(sLine) > Len(sKey) Then
                If Left(sLine, Len(sKey) + 1) = sKey & "=" Then
                    bKeyExists = True
                    Ini_ReadKeyVal = Mid(sLine, InStr(sLine, "=") + 1)
                End If
            End If
        End If
    Next i

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    'Err.Number = 75 'File does not exist, Permission issues to write is denied,
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Ini_ReadKeyVal" & vbCrLf & _
           "Error Description: " & Err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

'---------------------------------------------------------------------------------------
' Procedure : Ini_WriteKeyVal
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' Purpose   : Writes a Key value to the specified Ini file's Section
'               If the file does not exist, it will be created
'               If the Section does not exist, it will be appended to the existing content
'               If the Key does not exist, it will be appended to the existing Section content
' Copyright : The following is release as Attribution-ShareAlike 4.0 International
'             (CC BY-SA 4.0) - 
' Req'd Refs: Uses Late Binding, so none required
'             No APIs either! 100% VBA
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sIniFile  : Full path and filename of the ini file to edit
' sSection  : Ini Section to search for the Key to edit
' sKey      : Name of the Key to edit
' sValue    : Value to associate to the Key
'
' Usage:
' ~~~~~~
' Call Ini_WriteKeyVal(Application.CurrentProject.Path & "\MyIniFile.ini", "LINKED TABLES", "Paths", "D:\")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2012-08-09              Initial Release
' 2         2025-06-03              Updated version to address 2 bugs found in previous
'                                   version (Thanks to Xavier Batlle for bringing 1 of
'                                   the bugs to my attention).
'                                   Updated Copyright.
'---------------------------------------------------------------------------------------
Function Ini_WriteKeyVal(ByVal sIniFile As String, _
                         ByVal sSection As String, _
                         ByVal sKey As String, _
                         ByVal sValue As String) As Boolean
    On Error GoTo Error_Handler

    Dim sIniFileContent       As String
    Dim aIniLines()           As String
    Dim sLine                 As String
    Dim sNewLine              As String
    Dim i                     As Long
    Dim bFileExist            As Boolean
    Dim bInSection            As Boolean
    Dim bSectionExists        As Boolean
    Dim bKeyExists            As Boolean
    Dim bKeyAdded             As Boolean

    sIniFileContent = ""
    bSectionExists = False
    bKeyExists = False
    bKeyAdded = False
    bInSection = False

    ' Validate that the file actually exists
    bFileExist = FileExist(sIniFile)
    If bFileExist Then
        sIniFileContent = ReadFile(sIniFile)    ' Read the file into memory
        If Len(sIniFileContent) > 0 Then
            aIniLines = Split(sIniFileContent, vbCrLf)    ' Break the content into individual lines
        Else
            ReDim aIniLines(0)
            aIniLines(0) = ""
        End If
    Else
        ' File does not exist, start with empty lines
        ReDim aIniLines(0)
        aIniLines(0) = ""
    End If

    sIniFileContent = ""    ' Reset it

    For i = 0 To UBound(aIniLines)
        sLine = Trim(aIniLines(i))
        sNewLine = ""

        ' Detect section
        If sLine = "(" & sSection & ")" Then
            bSectionExists = True
            bInSection = True
        ElseIf Left(sLine, 1) = "(" And Right(sLine, 1) = ")" Then
            ' If we were in the target section and hit a new section, check if key was added
            If bInSection And Not bKeyExists Then
                If Len(sIniFileContent) > 0 Then sIniFileContent = sIniFileContent & vbCrLf
                sIniFileContent = sIniFileContent & sKey & "=" & sValue
                bKeyAdded = True
            End If
            bInSection = False
        End If

        ' If inside the target section, check for the key
        If bInSection And Not bKeyExists Then
            If InStr(1, sLine, sKey & "=", vbTextCompare) = 1 Then
                sNewLine = sKey & "=" & sValue
                bKeyExists = True
                bKeyAdded = True
            End If
        End If

        ' Build the new content
        If Len(sIniFileContent) > 0 Then sIniFileContent = sIniFileContent & vbCrLf
        If sNewLine = "" Then
            sIniFileContent = sIniFileContent & sLine
        Else
            sIniFileContent = sIniFileContent & sNewLine
        End If
    Next i

    ' If section was not found, add it and the key at the end
    If Not bSectionExists Then
        If Len(sIniFileContent) > 0 Then sIniFileContent = sIniFileContent & vbCrLf
        sIniFileContent = sIniFileContent & "(" & sSection & ")" & vbCrLf & sKey & "=" & sValue
    ElseIf Not bKeyAdded Then
        ' Section exists, but key was not found, so add it at the end of the section
        If Right(sIniFileContent, 2) <> vbCrLf Then sIniFileContent = sIniFileContent & vbCrLf
        sIniFileContent = sIniFileContent & sKey & "=" & sValue
    End If

    ' Write to the ini file the new content
    Call OverwriteTxt(sIniFile, sIniFileContent)
    Ini_WriteKeyVal = True

Error_Handler_Exit:
    On Error Resume Next
    Exit Function

Error_Handler:
    MsgBox "The following error has occurred" & vbCrLf & vbCrLf & _
           "Error Number: " & Err.Number & vbCrLf & _
           "Error Source: Ini_WriteKeyVal" & vbCrLf & _
           "Error Description: " & Err.Description, _
           vbOKOnly + vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Lo anterior también requiere las siguientes funciones auxiliares

'---------------------------------------------------------------------------------------
' Procedure : FileExist
' DateTime  : 2007-Mar-06 13:51
' Author    : CARDA Consultants Inc.
' Website   : 
' Purpose   : Test for the existance of a file; Returns True/False
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strFile - name of the file to be tested for including full path
'---------------------------------------------------------------------------------------
Function FileExist(strFile As String) As Boolean
    On Error GoTo Err_Handler

    FileExist = False
    If Len(Dir(strFile)) > 0 Then
        FileExist = True
    End If

Exit_Err_Handler:
    Exit Function

Err_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: FileExist" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occurred!"
    GoTo Exit_Err_Handler
End Function

'---------------------------------------------------------------------------------------
' Procedure : OverwriteTxt
' Author    : Daniel Pineault, CARDA Consultants Inc.
' Website   : 
' Purpose   : Output Data to an external file (*.txt or other format)
'             ***Do not forget about access' DoCmd.OutputTo Method for
'             exporting objects (queries, report,...)***
'             Will overwirte any data if the file already exists
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sFile - name of the file that the text is to be output to including the full path
' sText - text to be output to the file
'
' Usage:
' ~~~~~~
' Call OverwriteTxt("C:\Users\Vance\Documents\EmailExp2.txt", "Text2Export")
'
' Revision History:
' Rev       Date(yyyy/mm/dd)        Description
' **************************************************************************************
' 1         2012-Jul-06                 Initial Release
'---------------------------------------------------------------------------------------
Function OverwriteTxt(sFile As String, sText As String)
On Error GoTo Err_Handler
    Dim FileNumber As Integer
 
    FileNumber = FreeFile                   ' Get unused file number
    Open sFile For Output As #FileNumber    ' Connect to the file
    Print #FileNumber, sText;                ' Append our string
    Close #FileNumber                       ' Close the file
 
Exit_Err_Handler:
    Exit Function
 
Err_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: OverwriteTxt" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occurred!"
    GoTo Exit_Err_Handler
End Function

'---------------------------------------------------------------------------------------
' Procedure : ReadFile
' Author    : CARDA Consultants Inc.
' Website   : 
' Purpose   : Faster way to read text file all in RAM rather than line by line
' Copyright : The following may be altered and reused as you wish so long as the
'             copyright notice is left unchanged (including Author, Website and
'             Copyright).  It may not be sold/resold or reposted on other sites (links
'             back to this site are allowed).
' Input Variables:
' ~~~~~~~~~~~~~~~~
' strFile - name of the file that is to be read
'
' Usage Example:
' ~~~~~~~~~~~~~~~~
' MyTxt = ReadText("c:\tmp\test.txt")
' MyTxt = ReadText("c:\tmp\test.sql")
' MyTxt = ReadText("c:\tmp\test.csv")
'---------------------------------------------------------------------------------------
Function ReadFile(ByVal strFile As String) As String
On Error GoTo Error_Handler
    Dim FileNumber  As Integer
    Dim sFile       As String 'Variable contain file content
 
    FileNumber = FreeFile
    Open strFile For Binary Access Read As FileNumber
    sFile = Space(LOF(FileNumber))
    Get #FileNumber, , sFile
    Close FileNumber
 
    ReadFile = sFile
 
Error_Handler_Exit:
    On Error Resume Next
    Exit Function
 
Error_Handler:
    MsgBox "The following error has occurred." & vbCrLf & vbCrLf & _
            "Error Number: " & Err.Number & vbCrLf & _
            "Error Source: ReadFile" & vbCrLf & _
            "Error Description: " & Err.Description, _
            vbCritical, "An Error has Occurred!"
    Resume Error_Handler_Exit
End Function

Con el código anterior, ahora puede leer fácilmente cualquier valor de clave de archivo INI y escribir/actualizar valores de clave haciendo algo como

Sub TestReadKey()
    MsgBox "INI File: " & Application.CurrentProject.Path & "\MyIniFile.ini" & vbCrLf & _
           "Section: SETTINGS" & vbCrLf & _
           "Section Exist: " & bSectionExists & vbCrLf & _
           "Key: License" & vbCrLf & _
           "Key Exist: " & bKeyExists & vbCrLf & _
           "Key Value: " & Ini_ReadKeyVal(Application.CurrentProject.Path & "\MyIniFile.ini", "SETTINGS", "License")
    'You can validate the value by checking the bSectionExists and bKeyExists variable to ensure they were actually found in the ini file
End Sub

Sub TestWriteKey()
    If Ini_WriteKeyVal(Application.CurrentProject.Path & "\MyIniFile.ini", "SETTINGS", "License", "JBXR-HHTY-LKIP-HJNB-GGGT") = True Then
        MsgBox "The key was written"
    Else
        MsgBox "An error occurred!"
    End If
End Sub

Trabajar con archivos INI usando API

En aras de la integridad, pensé en demostrar brevemente el uso de las API de Windows para manipular archivos INI.

El código básico podría parecer:

#If VBA7 Then
    Private Declare PtrSafe Function GetPrivateProfileStringA Lib "kernel32" ( _
            ByVal lpApplicationName As String, _
            ByVal lpKeyName As String, _
            ByVal lpDefault As String, _
            ByVal lpReturnedString As String, _
            ByVal nSize As Long, _
            ByVal lpFileName As String) As Long
    Private Declare PtrSafe Function WritePrivateProfileStringA Lib "kernel32" ( _
            ByVal lpApplicationName As String, _
            ByVal lpKeyName As String, _
            ByVal lpString As String, _
            ByVal lpFileName As String) As Long
#Else
    Private Declare Function GetPrivateProfileStringA Lib "kernel32" ( _
            ByVal lpApplicationName As String, _
            ByVal lpKeyName As String, _
            ByVal lpDefault As String, _
            ByVal lpReturnedString As String, _
            ByVal nSize As Long, _
            ByVal lpFileName As String) As Long
    Private Declare Function WritePrivateProfileStringA Lib "kernel32" ( _
            ByVal lpApplicationName As String, _
            ByVal lpKeyName As String, _
            ByVal lpString As String, _
            ByVal lpFileName As String) As Long
#End If


Function ReadIniValue(ByVal sFile As String, _
                      ByVal sSection As String, _
                      ByVal sKey As String, _
                      Optional ByVal sDefault As String = "") As String
    Dim sBuffer               As String
    Dim lRet                  As Long

    sBuffer = String$(1024, vbNullChar)    ' Buffer for the result
    lRet = GetPrivateProfileStringA(sSection, sKey, sDefault, sBuffer, Len(sBuffer), sFile)
    If lRet > 0 Then
        ReadIniValue = Left$(sBuffer, lRet)
    Else
        ReadIniValue = sDefault
    End If
End Function

Function WriteIniValue(ByVal sFile As String, _
                       ByVal sSection As String, _
                       ByVal sKey As String, _
                       ByVal sValue As String) As Boolean
    Dim lRet As Long

    lRet = WritePrivateProfileStringA(sSection, sKey, sValue, sFile)
    WriteIniValue = (lRet <> 0)
End Function

Function DeleteIniKey(ByVal sFile As String, _
                      ByVal sSection As String, _
                      ByVal sKey As String) As Boolean
    'Supplying a vbNullString actually deletes the key and/or section!
    Dim lRet As Long
    lRet = WritePrivateProfileStringA(sSection, sKey, vbNullString, sFile)
    DeleteIniKey = (lRet <> 0)
End Function

Function DeleteIniSection(ByVal sFile As String, _
                          ByVal sSection As String) As Boolean
    Dim lRet As Long
    lRet = WritePrivateProfileStringA(sSection, vbNullString, vbNullString, sFile)
    DeleteIniSection = (lRet <> 0)
End Function

Y a continuación hay un par de ejemplos de cómo se usan:

Sub ReadIniValue_Test()
    Debug.Print ReadIniValue(Application.CurrentProject.Path & "\MyIniFile.ini", "Settings", "Licenses")
End Sub

Sub WriteIniValue_Test()
    Debug.Print WriteIniValue(Application.CurrentProject.Path & "\MyIniFile.ini", "Settings", "Licenses", "MyValue")
End Sub

Sub DeleteIniKey_Test()
    Debug.Print DeleteIniKey(Application.CurrentProject.Path & "\MyIniFile.ini", "Settings", "License")
End Sub

Sub DeleteIniSection_Test()
    Debug.Print DeleteIniSection(Application.CurrentProject.Path & "\MyIniFile.ini", "Settings")
End Sub

Historial de la página