Private profilstrenge ved hjælp af INI-filer ved hjælp af VBA i Microsoft Excel

Anonim

Private profilstrenge bruges ofte til at gemme brugerspecifikke oplysninger uden for applikationen/dokumentet til senere brug.
Du kan f.eks. Gemme oplysninger om det nyeste indhold i en dialog/brugerform,
hvor mange gange en projektmappe er blevet åbnet eller det sidst anvendte fakturanummer til en fakturaskabelon.
Oplysningerne kan gemmes i en INI-fil, enten på den lokale harddisk eller i en delt netværksmappe.
En INI-fil er en almindelig tekstfil, og indholdet kan se sådan ud:

[PERSONLIG]
Efternavn = Doe
Fornavn = John
Fødselsdato = 1.1.1960
UniqueNumber = 123456
Private profilstrenge for hver bruger kan også gemmes i registreringsdatabasen.

Excel har ingen indbygget funktionalitet til læsning og skrivning til INI-filer såsom Word har (System.PrivateProfileString),
så du har brug for et par API-funktioner for at gøre dette på en nem måde.
Her er eksemplerne på makroer til at skrive til og læse fra en INI-fil, der indeholder private profilstrenge.

Const IniFileName As String = "C: \ FolderName \ UserInfo.ini"
'stien og filnavnet til filen, der indeholder de oplysninger, du vil læse/skrive

Privat erklære funktion 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 _ "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, 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 GoPoTrileFileSt32 , _ ByVal strSection As String, ByVal strKey As String, _ Valgfri strDefault) As String Dim strReturnStri ng 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, _KRD, lngSize, strFileName) GetPrivateProfileString32 = Left (strReturnString, lngValid) On Error GoTo 0 End Function 'eksemplerne herunder antager, at området B3: B5 i det aktive ark indeholder' information om efternavn, fornavn og fødselsdato Sub WriteUserInfo () 'gemmer oplysninger i filen IniFileName If Not WritePrivateProfileString32 (IniFileName, "PERSONAL", _ "Efternavn", Range ("B3"). Værdi) Så kan MsgBox "Ikke gemme brugeroplysninger i" & IniFileName, _ vbExclamation, "Mappe findes ikke! " Exit Sub End If WritePrivateProfileString32 IniFileName, "PERSONAL", _ "Lastname", Range ("B3"). Value WritePrivateProfileString32 IniFileName, "PERSONAL", _ "Firstname", Range ("B4"). Value WritePrivateProfileString32 IniFILName, " , _ "Fødselsdato", Område ("B5"). Værdi Slut Sub Sub ReadUserInfo () 'læser oplysninger fra filen IniFileName If Dir (IniFileName) = "" Afslut derefter underområde ("B3"). Formula = GetPrivateProfileString32 (IniFileName , _ "PERSONAL", "Efternavn") Område ("B4"). Formel = GetPrivateProfileString32 (IniFileName, _ "PERSONAL", "Fornavn") Område ("B5"). Formel = GetPrivateProfileString32 (IniFileName, _ "PERSONAL", "Fødselsdato") Slut Sub 'i eksemplet nedenfor antages det, at området D4 i det aktive ark indeholder' information om det unikke nummer Sub GetNewUniqueNumber () Dim UniqueNumber så længe If Dir (IniFileName) = "" Afslut derefter Sub UniqueNumber = 0 ved fejl Genoptag næste UniqueNumber = CLng (GetPrivateProfileString32 (IniFileName, _ "PERSONAL", "UniqueNumber")) Ved fejl GoTo 0 Område ("D4"). Formel = UniqueNumber + 1 If Not WritePrivateProfileString32 (IniFileName, "PERSONAL", _ "UniqueNumber", Range ("D4"). Værdi) Så kan MsgBox "Ikke gemme brugeroplysninger i" & IniFileName , _ vbExclamation, "Mappen findes ikke!" Exit Sub End If End Sub