Private Profile Strings using INI-files
2000-04-07 VBA programming 0 696
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=123456Private 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