ERLANDSEN DATA CONSULTING Excel & VBA Tips   Informasjon på norsk / Information in Norwegian

These pages are no longer updated and are only available for archive purposes.

Click here to visit the pages with updated information.

Private Profile Strings using INI-files

Private Profile Strings are often used to store user specific information outside the application/document for later use. You could for example store information about the latest content in a dialog/UserForm, how many times a workbook has been opened or the last used invoice number for an invoice template. The information can be stored in an INI-file, either on the local hard disk or in a shared network folder. An INI-file is an ordinary text file and the content could look something like this:

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

Private Profile Strings for each user can also be stored in the Registry.

Excel has no built-in functionality for reading and writing to INI-files such as Word has (System.PrivateProfileString), so you need a couple of API-functions to do this in an easy way. Here are the example macros for writing to and reading from an INI-file containing Private Profile Strings.

Const IniFileName As String = "C:\FolderName\UserInfo.ini"
' the path and filename to the file containing the information you want to read/write


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

 

Document last updated 2000-04-07 12:50:24      Printerfriendly version

 

Erlandsen Data Consulting     http://www.erlandsendata.no/   
Excel & VBA Tips   Copyright ©1999-2017    Ole P. Erlandsen   All rights reserved
E-mail Contact Address