Strings de Perfil Privado usando arquivos INI usando VBA no Microsoft Excel

Anonim

As strings de perfil privado são freqüentemente usadas para armazenar informações específicas do usuário fora do aplicativo / documento para uso posterior.
Você poderia, por exemplo, armazenar informações sobre o conteúdo mais recente em uma caixa de diálogo / formulário de usuário,
quantas vezes uma pasta de trabalho foi aberta ou o último número de fatura usado para um modelo de fatura.
As informações podem ser armazenadas em um arquivo INI, no disco rígido local ou em uma pasta de rede compartilhada.
Um arquivo INI é um arquivo de texto comum e o conteúdo pode ter a seguinte aparência:

[PESSOAL]
Sobrenome = Doe
Primeiro nome = John
Data de Nascimento = 1.1.1960
UniqueNumber = 123456
As Strings de Perfil Privado de cada usuário também podem ser armazenadas no Registro.

O Excel não tem funcionalidade interna para ler e gravar em arquivos INI, como o Word tem (System.PrivateProfileString),
então você precisa de algumas funções de API para fazer isso de uma maneira fácil.
Aqui estão os exemplos de macros para gravar e ler um arquivo INI contendo Strings de Perfil Privado.

Const IniFileName As String = "C: \ FolderName \ UserInfo.ini"
'o caminho e nome do arquivo para o arquivo que contém as informações que você deseja ler / escrever

Função Declare Privada GetPrivateProfileStringA Lib _ "Kernel32" (ByVal strSection As String, _ ByVal strKey As String, ByVal strDefault As String, _ ByVal strReturnedString As String, _ ByVal lngSize As Long, ByVal strFileName As String, ByVal strDefault As String, _ ByVal strReturnedString As String, _ ByVal lngSize As Long, ByVal strFileNameName As String Função WritePrivate As String Privado Longo _ "Kernel32" (ByVal strSection As String, _ ByVal strKey As String, ByVal strString As String, _ ByVal strFileName 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 Função privada por GetPrivate32 , _ ByVal strSection As String, ByVal strKey As String, _ Opcional strDefault) As String Dim strReturnStri ng 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, _RefaultDefault, lngSize, strFileName) GetPrivateProfileString32 = Left (strReturnString, lngValid) On Error GoTo 0 End Function 'os exemplos abaixo assumem que o intervalo B3: B5 na planilha ativa contém' informações sobre Sobrenome, Nome e Data de Nascimento Sub WriteUserInfo () 'salva informações em o arquivo IniFileName If Not WritePrivateProfileString32 (IniFileName, "PERSONAL", _ "Lastname", Range ("B3"). Value) Then MsgBox "Não foi possível salvar as informações do usuário em" & IniFileName, _ vbExclamation, "A pasta não existe! " Exit Sub End If WritePrivateProfileString32 IniFileName, "PERSONAL", _ "Lastname", Range ("B3"). Valor WritePrivateProfileString32 IniFileName, "PERSONAL", _ "Firstname", Range ("B4"). Valor WritePrivateProfileString32 IniFile " , _ "Birthdate", Range ("B5"). Value End Sub Sub ReadUserInfo () 'lê as informações do arquivo 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", "Data de nascimento") End Sub 'o exemplo abaixo assume que o intervalo D4 na planilha ativa contém' informações sobre o número exclusivo Sub GetNewUniqueNumber () Dim UniqueNumber As Long If Dir (IniFileName) = "" Then Exit Sub UniqueNumber = 0 em caso de erro Retomar o próximo UniqueNumber = CLng (GetPrivateProfileString32 (IniFileName, _ "PERSONAL", "UniqueNumber")) Em erro GoTo 0 Range ("D4"). Formula = UniqueNumber + 1 If Not WritePrivateProfileString32 (IniFileName, "PERSONAL", _ "UniqueNumber", Range ("D4"). Value) Then MsgBox "Não é possível salvar as informações do usuário em" & IniFileName , _ vbExclamation, "A pasta não existe!" Exit Sub End If End Sub