Perfil privado cadenas utilizando INI archivos utilizando VBA en Microsoft Excel
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 ordinario y el contenido podría verse así:
Lastname = Doe Firstname = John Birthdate = 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 los ejemplos de macros 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
Private Declare Function GetPrivateProfileStringA Lib _
"Kernel32" (ByVal strSection As String, _
ByVal strKey As String, ByVal strDefault As String, _
ByVal strReturnedString As String, _
ByVal lngSize As Long, ByVal strFileNameName As String) As Long
Private Declare Function WritePrivateProfileStringA Lib _
"Kernel32" (ByVal strSection As String, _
ByVal strKey As String, ByVal strString As String, _
ByVal strFileNameName As String) As Long
Private Function WritePrivateProfileString32(ByVal strFileName As String, _
ByVal strSection As String, ByVal strKey As String, _
ByVal strValue As String) As Boolean
Dim lngValid As Long
On Error Resume Next
lngValid = WritePrivateProfileStringA(strSection, strKey, _
strValue, strFileName)
If lngValid > 0 Then WritePrivateProfileString32 = True
On Error GoTo 0
End Function
Private Function GetPrivateProfileString32(ByVal strFileName As String, _
ByVal strSection As String, ByVal strKey As String, _
Optional strDefault) As String
Dim strReturnString As String, lngSize As Long, lngValid As Long
On Error Resume Next
If IsMissing(strDefault) Then strDefault = ""
strReturnString = Space(1024)
lngSize = Len(strReturnString)
lngValid = GetPrivateProfileStringA(strSection, strKey, _
strDefault, strReturnString, lngSize, strFileName)
GetPrivateProfileString32 = Left(strReturnString, lngValid)
On Error GoTo 0
End Function
' the examples below assumes that the range B3:B5 in the active sheet contains
' information about Lastname, Firstname and Birthdate
Sub WriteUserInfo()
' saves information in the file IniFileName
If Not WritePrivateProfileString32(IniFileName, "PERSONAL", _
"Lastname", Range("B3").Value) Then
MsgBox "Not able to save user info in " & IniFileName, _
vbExclamation, "Folder does not exist!"
Exit Sub
End If
WritePrivateProfileString32 IniFileName, "PERSONAL", _
"Lastname", Range("B3").Value
WritePrivateProfileString32 IniFileName, "PERSONAL", _
"Firstname", Range("B4").Value
WritePrivateProfileString32 IniFileName, "PERSONAL", _
"Birthdate", Range("B5").Value
End Sub
Sub ReadUserInfo()
' reads information from the file IniFileName
If Dir(IniFileName) = "" Then Exit Sub
Range("B3").Formula = GetPrivateProfileString32(IniFileName, _
"PERSONAL", "Lastname")
Range("B4").Formula = GetPrivateProfileString32(IniFileName, _
"PERSONAL", "Firstname")
Range("B5").Formula = GetPrivateProfileString32(IniFileName, _
"PERSONAL", "Birthdate")
End Sub
' the example below assumes that the range D4 in the active sheet contains
' information about the unique number
Sub GetNewUniqueNumber()
Dim UniqueNumber As Long
If Dir(IniFileName) = "" Then Exit Sub
UniqueNumber = 0
On Error Resume Next
UniqueNumber = CLng(GetPrivateProfileString32(IniFileName, _
"PERSONAL", "UniqueNumber"))
On Error GoTo 0
Range("D4").Formula = UniqueNumber + 1
If Not WritePrivateProfileString32(IniFileName, "PERSONAL", _
"UniqueNumber", Range("D4").Value) Then
MsgBox "Not able to save user info in " & IniFileName, _
vbExclamation, "Folder does not exist!"
Exit Sub
End If
End Sub