|  

Private Profile Strings using INI-files using VBA in Microsoft Excel

VBA macro tip contributed by Erlandsen Data Consulting offering Microsoft Excel Application development, template customization, support and training solutions 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

Rate This Tip
1 2 3 4 5
Rating: 4.33     Views: 31413
No comments have been submitted.
Click here to post comment
For Registered Users
Name
Comment Title
Comments