Private profilstrenger som bruker INI-filer ved hjelp av VBA i Microsoft Excel

Anonim

Private profilstrenger brukes ofte til å lagre brukerspesifikk informasjon utenfor applikasjonen/dokumentet for senere bruk.
Du kan for eksempel lagre informasjon om det siste innholdet i en dialog/brukerform,
hvor mange ganger en arbeidsbok har blitt åpnet eller det siste brukte fakturanummeret for en fakturamal.
Informasjonen kan lagres i en INI-fil, enten på den lokale harddisken eller i en delt nettverksmappe.
En INI-fil er en vanlig tekstfil og innholdet kan se omtrent slik ut:

[PERSONLIG]
Etternavn = Doe
Fornavn = John
Fødselsdato = 1.1.1960
UniqueNumber = 123456
Private profilstrenger for hver bruker kan også lagres i registret.

Excel har ingen innebygd funksjonalitet for å lese og skrive til INI-filer som Word har (System.PrivateProfileString),
så du trenger et par API-funksjoner for å gjøre dette på en enkel måte.
Her er eksempler på makroer for å skrive til og lese fra en INI-fil som inneholder private profilstrenger.

Const IniFileName As String = "C: \ FolderName \ UserInfo.ini"
'banen og filnavnet til filen som inneholder informasjonen du vil lese/skrive

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 _ "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, 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 StoppFunStringFileSt32 , _ ByVal strSection As String, ByVal strKey As String, _ Valgfri 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, _KRD, lngSize, strFileName) GetPrivateProfileString32 = Left (strReturnString, lngValid) On Error GoTo 0 End Function 'eksemplene nedenfor antar at området B3: B5 i det aktive arket inneholder' informasjon om etternavn, fornavn og fødselsdato Sub WriteUserInfo () 'lagrer informasjon i filen IniFileName If Not WritePrivateProfileString32 (IniFileName, "PERSONAL", _ "Etternavn", Range ("B3"). Verdi) Da MsgBox "Kan ikke lagre brukerinformasjon i" & IniFileName, _ vbExclamation, "Mappen finnes ikke! " Avslutt underenden Hvis WritePrivateProfileString32 IniFileName, "PERSONAL", _ "Lastname", Range ("B3"). Value WritePrivateProfileString32 IniFileName, "PERSONAL", _ "Firstname", Range ("B4"). Value WritePrivateProfileString32 IniFileName, , _ "Birthdate", Range ("B5"). Value End Sub Sub ReadUserInfo () 'leser informasjon fra filen IniFileName If Dir (IniFileName) = "" Deretter avslutter du Sub Range ("B3"). Formula = GetPrivateProfileString32 (IniFileName , _ "PERSONAL", "Etternavn") Område ("B4"). Formel = GetPrivateProfileString32 (IniFileName, _ "PERSONAL", "Fornavn") Range ("B5"). Formula = GetPrivateProfileString32 (IniFileName, _ "PERSONAL", "Fødselsdato") End Sub 'i eksemplet nedenfor forutsetter at området D4 i det aktive arket inneholder' informasjon om det unike nummeret Sub GetNewUniqueNumber () Dim UniqueNumber As Long If Dir (IniFileName) = "" Deretter avslutt Sub UniqueNumber = 0 Ved feil Fortsett neste UniqueNumber = CLng (GetPrivateProfileString32 (IniFileName, _ "PERSONAL", "UniqueNumber")) Ved feil GoTo 0 Range ("D4"). Formel = UniqueNumber + 1 If Not WritePrivateProfileString32 (IniFileName, "PERSONAL", _ "UniqueNumber", Range ("D4"). Value) Then MsgBox "Ikke i stand til å lagre brukerinformasjon i" & IniFileName , _ vbExclamation, "Mappen finnes ikke!" Avslutt Sub End Hvis End Sub