Private Profile Strings med INI-filer

Private Profile Strings benyttes til å lagre brukerspesifikk informasjon utenfor programmet/dokumentet for senere bruk. Man kan for eksempel lagre informasjon om hva som sist ble utfylt i en dialog/UserForm, hvor mange ganger en arbeidsbok har blitt åpnet eller det siste nummeret som ble brukt på av 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 med et innhold som kan se slik ut:

[PERSONAL]
Lastname=Doe
Firstname=John
Birthdate=1.1.1960
UniqueNumber=123456

Private Profile Strings for den enkelte brukeren kan også lagres i Registeret

Excel har ingen innebygd funksjonalitet for å lese og skrive til INI-filer slik som Word har (System.PrivateProfileString), så man trenger et par API-funksjoner for å gjøre dette på en enkel måte. Her er eksemplene som viser hvordan man på en enkel måte kan lese og skrive informasjon i en ini-fil som inneholder Private Profile Strings.

Const IniFileName As String = "C:\FolderName\UserInfo.ini"
' mappenavn og filnavn til den filen som inneholder informasjonen du vil lese/lagre

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

' eksemplene nedenfor forutsetter at området B3:B5 i det aktive regnearket inneholder
' informasjon om Lastname, Firstname og Birthdate

Sub WriteUserInfo()
' lagrer informasjon i filen IniFileName
    If Not WritePrivateProfileString32(IniFileName, "PERSONAL", _
        "Lastname", Range("B3").Value) Then
        MsgBox "Kan ikke lagre brukerinformasjon i " & IniFileName, _
            vbExclamation, "Mappen finnes ikke!"
        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()
' leser informasjon fra filen 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

' eksempelet nedenfor forutsetter at celle D4 i det aktive regnearket inneholder
' informasjon om den unike verdien (f.eks. et fakturanummer)

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 "Kan ikke lagre brukerinformasjon i " & _
            IniFileName, vbExclamation, "Mappen finnes ikke!"
        Exit Sub
    End If
End Sub

Dokumentet er sist oppdatert 2000-04-07 12:36:02 Utskriftsvennlig versjon