Cadenas de perfil privado que usan archivos INI usando VBA en Microsoft Excel

Anonim

Las cadenas de perfiles privados se utilizan a menudo para almacenar información específica del usuario fuera de la aplicación / documento para su uso posterior.
Por ejemplo, podría almacenar información sobre el contenido más reciente en un cuadro de diálogo / formulario de usuario,
cuántas veces se ha abierto un libro de trabajo o el último número de factura utilizado para una plantilla de factura.
La información se puede almacenar en un archivo INI, ya sea en el disco duro local o en una carpeta de red compartida.
Un archivo INI es un archivo de texto normal y el contenido podría verse así:

[PERSONAL]
Apellido = Doe
Nombre = John
Fecha de nacimiento = 1.1.1960
UniqueNumber = 123456
Las cadenas de perfiles privados de cada usuario también se pueden almacenar en el registro.

Excel no tiene una funcionalidad incorporada para leer y escribir en archivos INI como Word tiene (System.PrivateProfileString),
por lo que necesita un par de funciones API para hacer esto de una manera fácil.
Aquí están las macros de ejemplo para escribir y leer desde un archivo INI que contiene cadenas de perfiles privados.

Const IniFileName As String = "C: \ FolderName \ UserInfo.ini"
'la ruta y el nombre del archivo que contiene la información que desea leer / escribir

Función de declaración privada GetPrivateProfileStringA Lib _ "Kernel32" (ByVal strSection como cadena, _ ByVal strKey como cadena, ByVal strDefault como cadena, _ ByVal strReturnedString como cadena, _ ByVal lngSize As Long, ByVal strFileNameName como cadena) As Long Private Libre Función WritePrivate _ "Kernel32" (ByVal strSection como cadena, _ ByVal strKey como cadena, ByVal strString como cadena, _ ByVal strFileNameName como cadena) Como función privada larga WritePrivateProfileString32 (ByVal strFileName como cadena, _ ByVal strSection como cadena, ByVal strKey como cadena, _ ByVal strValue As String) As Boolean Dim lngValid As Long On Error Resume Next lngValid = WritePrivateProfileStringA (strSection, strKey, _ strValue, strFileName) Si lngValid> 0 Entonces WritePrivateProfileString32 = True en el error GoTo 0 , _ ByVal strSection como cadena, ByVal strKey como cadena, _ Opcional strDefault) Como cadena Dim strReturnStri ng As String, lngSize As Long, lngValid As Long On Error Continuar Siguiente If IsMissing (strDefault) Then strDefault = "" strReturnString = Espacio (1024) lngSize = Len (strReturnString) lngValid = GetPrivateProfileStringA (strSection, strDefaultString, _ strDefault lngSize, strFileName) GetPrivateProfileString32 = Left (strReturnString, lngValid) On Error GoTo 0 End Function 'los ejemplos a continuación asumen que el rango B3: B5 en la hoja activa contiene' información sobre Apellido, Nombre y Fecha de Nacimiento Sub WriteUserInfo () 'guarda información en el archivo IniFileName If Not WritePrivateProfileString32 (IniFileName, "PERSONAL", _ "Lastname", Range ("B3"). Value) Entonces MsgBox "No se puede guardar la información del usuario en" & IniFileName, _ vbExclamation, "¡La carpeta no existe! " Salir de Sub End If WritePrivateProfileString32 IniFileName, "PERSONAL", _ "Apellido", Rango ("B3"). Valor WritePrivateProfileString32 IniFileName, "PERSONAL", _ "Nombre", Rango ("B4"). Valor WritePrivateProfileString32 IniFileName, "PERSONAL" , _ "Fecha de nacimiento", Rango ("B5"). Valor End Sub Sub ReadUserInfo () 'lee información del archivo IniFileName Si Dir (IniFileName) = "" Luego sale del subrango ("B3"). Formula = GetPrivateProfileString32 (IniFileName , _ "PERSONAL", "Apellido") Intervalo ("B4"). Fórmula = GetPrivateProfileString32 (IniFileName, _ "PERSONAL", "Nombre") Intervalo ("B5"). Fórmula = GetPrivateProfileString32 (IniFileName, _ "PERSONAL", "Birthdate") End Sub 'el ejemplo siguiente asume que el rango D4 en la hoja activa contiene' información sobre el número único Sub GetNewUniqueNumber () Dim UniqueNumber As Long If Dir (IniFileName) = "" Entonces Salir de Sub UniqueNumber = 0 en caso de error Resume Next UniqueNumber = CLng (GetPrivateProfileString32 (IniFileName, _ "PERSONAL", "UniqueNumber")) En caso de error Ir a 0 Rango ("D4"). Fórmula = UniqueNumber + 1 Si no es WritePrivateProfileString32 (IniFileName, "PERSONAL", _ "UniqueNumber", Range ("D4"). Value) Entonces MsgBox "No se puede guardar la información del usuario en" & IniFileName , _ vbExclamation, "¡La carpeta no existe!" Salir de Sub Finalizar Si Finalizar Sub