Chuỗi hồ sơ cá nhân sử dụng tệp INI bằng VBA trong Microsoft Excel
Chuỗi hồ sơ cá nhân thường được sử dụng để lưu trữ thông tin cụ thể của người dùng bên ngoài ứng dụng / tài liệu để sử dụng sau này.
Ví dụ, bạn có thể lưu trữ thông tin về nội dung mới nhất trong hộp thoại / UserForm, số lần một sổ làm việc đã được mở hoặc số hóa đơn được sử dụng gần đây nhất cho một mẫu hóa đơn.
Thông tin có thể được lưu trữ trong tệp INI, trên đĩa cứng cục bộ hoặc trong thư mục mạng chia sẻ.
Tệp INI là một tệp văn bản thông thường và nội dung có thể trông giống như sau:
Lastname = Doe Firstname = John Birthdate = 1.1.1960 UniqueNumber = 123456 Chuỗi hồ sơ cá nhân cho mỗi người dùng cũng có thể được lưu trữ trong Sổ đăng ký.
Excel không có chức năng tích hợp để đọc và ghi vào tệp INI như Word có (System.PrivateProfileString), vì vậy bạn cần một vài hàm API để thực hiện việc này một cách dễ dàng.
Dưới đây là các macro ví dụ để ghi và đọc từ tệp INI chứa Chuỗi hồ sơ cá nhân.
Const IniFileName As String = “C: \ FolderName \ UserInfo.ini”
‘đường dẫn và tên tệp đến tệp chứa thông tin bạn muốn đọc / ghi
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