Excel VBA INI Datei schreiben / lesen

matze.tele · 30. August 2023, 11:45

Hallo zusammen,

ich habe hier ein VBA Script mit dem ich in eine INI Datei schreiben möchte und daten auch wieder auslesen,
leider hat sich hier ein Fehler eingeschlichen, nur kann ich ihn nicht finden.
ob da vlt mal jemand drüber schauen kann und mir weiter helfen könnte.

Visual Basic-Quellcode

Option Explicit
Public Declare PtrSafe Function WritePrivateProfileString Lib "kernel32" _
Alias "WritePrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpString As Any, _
ByVal lpFileName As String) As Long
Public Declare PtrSafe Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" ( _
ByVal lpApplicationName As String, _
ByVal lpKeyName As Any, _
ByVal lpDefault As String, _
ByVal lpReturnedString As String, _
ByVal nSize As Long, _
ByVal lpFileName As String) As Long Dim myinifile As String
Dim PrintIP As String
Dim CValue, RValue, IPValue, PrinterValue As String
Dim lResult As Long
Public ColINI, RowINI, LocRang, ColBox, RowBox As String
Public Printer, IP_INI As String
Public Sub ColBoxCh_onChange(control As IRibbonControl, Text As String)
ColBox = Text
Debug.Print Text
Call writeColBox
End Sub
Public Sub writeColBox()
myinifile = "C:\Users\" & Environ("Username") & "\AppData\Roaming\Microsoft\AddIns\config_Z-Tools.ini"
WritePrivateProfileString "PWegLP", "ColBox", ColBox, myinifile
End Sub
Public Sub lesen()
myinifile = "C:\Users\" & Environ("Username") & "\AppData\Roaming\Microsoft\AddIns\config_Z-Tools.ini"
ColINI = ""
RowINI = ""
PrintIP = ""
Printer = ""
CValue = Space$(4)
RValue = Space$(4)
IPValue = Space$(16)
PrinterValue = Space$(1)
lResult = GetPrivateProfileString("PWegLP", "ColBox", ColINI, CValue, Len(CValue), myinifile)
ColINI = Left$(CValue, lResult)
lResult = GetPrivateProfileString("PWegLP", "RowBox", RowINI, RValue, Len(RValue), myinifile)
RowINI = Left$(RValue, lResult)
LocRang = ColINI + RowINI
lResult = GetPrivateProfileString("DruckerIP_Label", "IP", PrintIP, IPValue, Len(IPValue), myinifile)
IP_INI = Left$(IPValue, lResult)
lResult = GetPrivateProfileString("DruckerIP_Label", "Printer", Printer, PrinterValue, Len(PrinterValue), myinifile)
Printer = Left$(PrinterValue, lResult)
End Sub

VaporiZed · 30. August 2023, 16:19

Was meinst Du mit

matze.tele schrieb:

leider hat sich hier ein Fehler eingeschlichen

(Klingt wie bei einem Bilderrätsel: »Kannst Du alle zehn Fehler finden?«) Ist das nicht Dein eigener Code? Dann bitte Quelle verlinken. Wie äußert sich konkret der Fehler?

INOPIAE · 30. August 2023, 16:28

Warum schreibst Du das Ganze nicht einfach in eine Textdatei?

Visual Basic-Quellcode

Sub Lesen()
Dim fs As Object
Dim NFile
Set fs = CreateObject("Scripting.FileSystemObject")
On Error GoTo Fehler
Set NFile = fs.OpenTextFile(DeineDatei)
Dim strZeile() As String
Dim strTest As String
Do Until NFile.AtEndOfStream
strZeile = VBA.Split(NFile.ReadLine, ": ")
Select Case strZeile(0)
Case "VariableA"
VariableA = strZeile(1)
Case "VariableB"
VariableB= strZeile(1)
End Select
Loop
NFile.Close
Exit Sub
Fehler:
VBA.MsgBox Err.Number & " " & Err.Description & vbNewLine
End Sub
Sub Schreiben()
Dim fs As Object
Dim NFile
Set fs = CreateObject("Scripting.FileSystemObject")
On Error Resume Next
fs.DeleteFile (DeineDatei)
Set NFile = fs.CreateTextFile(DeineDatei)
NFile.WriteLine ("VariableA: " & VariableA)
NFile.WriteLine ("VariableB: " & VariableB)
NFile.Close
End Sub

Es muss noch ein Verweis auf die Scripting Runtime gesetzt werden.

petaod · 30. August 2023, 17:18

matze.tele schrieb:

ByVal lpFileName As String) As Long Dim myinifile As String

Wenn das kein Copy-Fehler ist, fehlt in Zeile 17 ein Zeilenumbruch.

matze.tele · 31. August 2023, 08:58

Hallo,
Danke für die schnelle Reaktion.

@petaod ja ist ein Copyfehler

@INOPIAE danke für den Tip und die Vorbereitung für mehr :huh:, aber es ging mir da nicht um's speichern der Daten sondern um den Fehler den ich vergaß zu erwähnen

@VaporiZed Ja entschuldige hab ich vergessen zu erwähnen, in Zeile 32 wird " ColBox " markiert, "Typen unverträglich" ist der Fehler

VaporiZed · 31. August 2023, 10:06

Naja, auch wenn der entsprechende Funktions-Parameter als Any eingestuft ist, glaube ich kaum, dass Du da einfach mal ein Control übergeben kannst. Spekulatius: Probier mal ColBox.Text.
Was ist ColBox eigentlich vom konkreten Datentyp her? Scheint ja ein Control zu sein. Aber was für eines?
btw: Allein dafür hasse ich VBA: ColBox = Text

matze.tele · 31. August 2023, 10:48

Hi @VaporiZed,

ich habe ein customUI ribbon mit editboxen, ColBox soll den Manuell eingegeben Spaltennamen enthalten, den will ich dann in einer INI speichern und auch wieder abfragen können.
Das Gleiche mache ich auch mit der Zeile, nur habe ich hier diesen Fehler.
Die Eingabe einer IP, bei Nachdruck, macht keine Probleme.

VaporiZed · 31. August 2023, 10:53

Der Verwendungszweck ist hier sekundär.
Es sind also EditBoxen. Meinst Du TextBox? Wieauchimmer. Ich glaub immer noch nicht, dass Du ein Control an die WritePrivateProfileString-Methode übergeben kannst. Dafür sind diese P/Invoke-Methoden viel zu empfindlich. Falls Du Zugriff auf den ColBox-Inhalt über den ControlNamen selbst hast, mach es notfalls über einen Zwischenstring:

Visual Basic-Quellcode

Public Sub writeColBox()
myinifile = "C:\Users\" & Environ("Username") & "\AppData\Roaming\Microsoft\AddIns\config_Z-Tools.ini"
Dim Foo As String
Foo = ColBox
WritePrivateProfileString "PWegLP", "ColBox", Foo, myinifile
End Sub

Eierlein · 31. August 2023, 12:26

in Zeile 32 wird " ColBox " markiert, "Typen unverträglich" ist der Fehler

Versuch mal ColBox als String zu DIMmen.
Evtl. funktioniert WritePrivateProfileString nicht mit Variant Variablen.

-Franky- · 31. August 2023, 13:24

@matze.tele
Deine API Deklaration ist falsch. Alle Parameter müssten also für WritePrivateProfileStringA = "As String" sein und kein Any.

C-Quellcode

BOOL WritePrivateProfileStringA(
[in] LPCSTR lpAppName,
[in] LPCSTR lpKeyName,
[in] LPCSTR lpString,
[in] LPCSTR lpFileName
);

Entsprechend sollten daher die zu übergebenden Variablen an WritePrivateProfileStringA auch "As String" sein.

volti · 31. August 2023, 14:03

Hallo,

sie müssen nicht als String deklariert werden, es kann auch ANY sein.

Ein Beispiel (hier 64 Bit Win/Excel),so wie ich das gern mache...

VB.NET-Quellcode

Private Declare PtrSafe Function GetPrivateProfileStringA Lib "kernel32" ( _
ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare PtrSafe Function WritePrivateProfileStringA Lib "kernel32" ( _
ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, _
ByVal lpFileName As String) As Long
Private Const csTxtdatei As String = "Testtextdaten.txt"
Function SetGetInidaten(sBereich As String, sItem As String, Optional sDaten As String) As String
'Schreibt Daten in die Textdatei oder liest Daten aus der Textdatei
Dim sPfad As String, sTxt As String * 5000, l As Integer
sPfad = Environ$("TEMP") & "\MyIni.txt"
If sDaten <> "" Then
WritePrivateProfileStringA sBereich, sItem, sDaten, sPfad
Else
l = GetPrivateProfileStringA(sBereich, sItem, "none", sTxt, 5000, sPfad)
SetGetInidaten = Left$(sTxt, l)
End If
End Function
Sub Schreibewas1()
SetGetInidaten "Sektor1", "MeinWert", "Hallo World!"
End Sub
Sub Lesewas1()
MsgBox SetGetInidaten("Sektor1", "MeinWert")
End Sub

-Franky- · 31. August 2023, 14:56

volti schrieb:

sie müssen nicht als String deklariert werden, es kann auch ANY sein.

stimmt, müssen nicht, aber da man nur Strings (LPCSTR) übergeben kann, macht es keinen Sinn die Parameter als Any auszulegen.

matze.tele · 31. August 2023, 16:16

Hallo @ all,

eure Tips haben mir weiter geholfen, hatte es nicht richtig deklariert.

nun habe ich ein weiteres Problem:
beim auslesen bekomme ich keine Daten, in der INI sind alle Daten vorhanden.

Visual Basic-Quellcode

Public Sub lesen()
myinifile = "C:\Users\" & Environ("Username") & "\AppData\Roaming\Microsoft\AddIns\config_Z-Tools.ini"
ColINI = ""
RowINI = ""
PrintIP = ""
Printer = ""
CValue = Space$(4)
RValue = Space$(4)
IPValue = Space$(16)
PrinterValue = Space$(1)
lResult = GetPrivateProfileString("PWegLP", "ColBox", ColINI, CValue, Len(CValue), myinifile)
ColINI = Left$(CValue, lResult)
lResult = GetPrivateProfileString("PWegLP", "RowBox", RowINI, RValue, Len(RValue), myinifile)
RowINI = Left$(RValue, lResult)
LocRang = ColINI + RowINI
lResult = GetPrivateProfileString("DruckerIP_Label", "IP", PrintIP, IPValue, Len(IPValue), myinifile)
IP_INI = Left$(IPValue, lResult)
lResult = GetPrivateProfileString("DruckerIP_Label", "Printer", Printer, PrinterValue, Len(PrinterValue), myinifile)
Printer = Left$(PrinterValue, lResult)
Debug.Print ColINI
Debug.Print RowINI
Debug.Print PrintIP
Debug.Print Printer
End Sub

volti · 31. August 2023, 17:03

Hallo Matze,

hier eine Idee dazu...

VB.NET-Quellcode

Private Declare PtrSafe Function GetPrivateProfileStringA Lib "kernel32" ( _
ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare PtrSafe Function WritePrivateProfileStringA Lib "kernel32" ( _
ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, _
ByVal lpFileName As String) As Long
Public Sub lesen()
Dim myinifile As String
Dim lResult As Long, sText As String * 32
Dim ColIni As String, RowIni As String, PrintIP As String, Printer As String
Dim LocRang As Long
myinifile = "C:\Users\" & Environ("Username") & "\AppData\Roaming\Microsoft\AddIns\config_Z-Tools.ini"
lResult = GetPrivateProfileStringA("PWegLP", "ColBox", "", sText, 32, myinifile)
ColIni = Left$(sText, lResult)
lResult = GetPrivateProfileStringA("PWegLP", "RowBox", "", sText, 32, myinifile)
RowIni = Left$(sText, lResult)
LocRang = Val(ColIni) + Val(RowIni)
lResult = GetPrivateProfileStringA("DruckerIP_Label", "IP", "", sText, 32, myinifile)
PrintIP = Left$(sText, lResult)
lResult = GetPrivateProfileStringA("DruckerIP_Label", "Printer", "", sText, 32, myinifile)
Printer = Left$(sText, lResult)
Debug.Print ColIni
Debug.Print RowIni
Debug.Print PrintIP
Debug.Print Printer
End Sub

Nachtrag:Die Vorgabewerte hatte ich rausgenommen, es wird also kein Wert zurückgegeben, wenn kein Eintrag da ist.Kannst Du natürlich bei Bedarf noch ergänzen.Beispiel:

VB.NET-Quellcode

lResult = GetPrivateProfileStringA("DruckerIP_Label", "Printer", "Canon 1234", sText, 32, myinifile)

Gruß
Karl-Heinz

matze.tele · 1. September 2023, 11:28

@volti Danke dir funktioniert jetzt, ich verstehe nur nicht wo der Fehler war

volti · 1. September 2023, 12:11

Hi Matze,

habe das jetzt nicht weiter verfolgt.

In deiner o.a. Sub hast Du die Variablen nicht gedimt, sie sind also variant. Wie Eierlein schon anmerkte könnte das der Fehler gewesen sein.

Ich hatte ja jetzt einfach immer die gleiche Variable sText füllen lassen. Diese muss dann auf den größten zu erwartenden Text oder mehr dimensioniert werden und kann später längengerecht in Deine Zielvariablen überführt werden.

Gruß KH

Morrison · 3. September 2023, 19:47

Ich hab hier ein .ini-Modul:

Spoiler anzeigen

Visual Basic-Quellcode

Option Explicit
Public bSectionExists As Boolean
Public bKeyExists As Boolean
'---------------------------------------------------------------------------------------
' Procedure : Ini_ReadKeyVal
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Read an Ini file's Key
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
' Req'd Refs: Uses Late Binding, so none required
' No APIs either! 100% VBA
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sIniFile : Full path and filename of the ini file to read
' sSection : Ini Section to search for the Key to read the Key from
' sKey : Name of the Key to read the value of
'
' Usage:
' ~~~~~~
' ? Ini_Read(Application.CurrentProject.Path & "\MyIniFile.ini", "LINKED TABLES", "Path")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2012-08-09 Initial Release
'---------------------------------------------------------------------------------------
Function Ini_ReadKeyVal(ByVal sIniFile As String, _
ByVal sSection As String, _
ByVal sKey As String) As String
On Error GoTo Error_Handler
Dim sIniFileContent As String
Dim aIniLines() As String
Dim sLine As String
Dim i As Long
sIniFileContent = ""
bSectionExists = False
bKeyExists = False
'Validate that the file actually exists
If FileExist(sIniFile) = False Then
MsgBox "The specified ini file: " & vbCrLf & vbCrLf & _
sIniFile & vbCrLf & vbCrLf & _
"could not be found.", vbCritical + vbOKOnly, "File not found"
GoTo Error_Handler_Exit
End If
sIniFileContent = ReadFile(sIniFile) 'Read the file into memory
aIniLines = Split(sIniFileContent, vbCrLf)
For i = 0 To UBound(aIniLines)
sLine = Trim(aIniLines(i))
If bSectionExists = True And Left(sLine, 1) = "[" And Right(sLine, 1) = "]" Then
Exit For 'Start of a new section
End If
If sLine = "[" & sSection & "]" Then
bSectionExists = True
End If
If bSectionExists = True Then
If Len(sLine) > Len(sKey) Then
If Left(sLine, Len(sKey) + 1) = sKey & "=" Then
bKeyExists = True
Ini_ReadKeyVal = Mid(sLine, InStr(sLine, "=") + 1)
End If
End If
End If
Next i
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
'Err.Number = 75 'File does not exist, Permission issues to write is denied,
MsgBox "Fehler im Modul 'Ini_ReadKeyVal'" & vbCrLf & vbCrLf & _
"Error Number: " & err.number & vbCrLf & _
"Error Source: Ini_ReadKeyVal" & vbCrLf & _
"Error Description: " & err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
'---------------------------------------------------------------------------------------
' Procedure : Ini_WriteKeyVal
' Author : Daniel Pineault, CARDA Consultants Inc.
' Website : http://www.cardaconsultants.com
' Purpose : Writes a Key value to the specified Ini file's Section
' If the file does not exist, it will be created
' If the Section does not exist, it will be appended to the existing content
' If the Key does not exist, it will be appended to the existing Section content
' Copyright : The following may be altered and reused as you wish so long as the
' copyright notice is left unchanged (including Author, Website and
' Copyright). It may not be sold/resold or reposted on other sites (links
' back to this site are allowed).
' Req'd Refs: Uses Late Binding, so none required
' No APIs either! 100% VBA
'
' Input Variables:
' ~~~~~~~~~~~~~~~~
' sIniFile : Full path and filename of the ini file to edit
' sSection : Ini Section to search for the Key to edit
' sKey : Name of the Key to edit
' sValue : Value to associate to the Key
'
' Usage:
' ~~~~~~
' Call Ini_WriteKeyVal(Application.CurrentProject.Path & "\MyIniFile.ini", "LINKED TABLES", "Paths", "D:\")
'
' Revision History:
' Rev Date(yyyy/mm/dd) Description
' **************************************************************************************
' 1 2012-08-09 Initial Release
' 2 2020-01-27 Fix to address issue flagged by users
'---------------------------------------------------------------------------------------
Function Ini_WriteKeyVal(ByVal sIniFile As String, _
ByVal sSection As String, _
ByVal sKey As String, _
ByVal sValue As String) As Boolean
On Error GoTo Error_Handler
Dim sIniFileContent As String
Dim aIniLines() As String
Dim sLine As String
Dim sNewLine As String
Dim i As Long
Dim bFileExist As Boolean
Dim bInSection As Boolean
Dim bKeyAdded As Boolean
sIniFileContent = ""
bSectionExists = False
bKeyExists = False
'Validate that the file actually exists
If FileExist(sIniFile) = False Then
GoTo SectionDoesNotExist
End If
bFileExist = True
sIniFileContent = ReadFile(sIniFile) 'Read the file into memory
aIniLines = Split(sIniFileContent, vbCrLf) 'Break the content into individual lines
sIniFileContent = "" 'Reset it
For i = 0 To UBound(aIniLines) 'Loop through each line
sNewLine = ""
sLine = Trim(aIniLines(i))
If sLine = "[" & sSection & "]" Then
bSectionExists = True
bInSection = True
End If
If bInSection = True Then
If sLine <> "[" & sSection & "]" Then
If Left(sLine, 1) = "[" And Right(sLine, 1) = "]" Then
'Our section exists, but the key wasn't found, so append it
sNewLine = sKey & "=" & sValue
i = i - 1
bInSection = False ' we're switching section
bKeyAdded = True
End If
End If
If Len(sLine) > Len(sKey) Then
If Left(sLine, Len(sKey) + 1) = sKey & "=" Then
sNewLine = sKey & "=" & sValue
bKeyExists = True
bKeyAdded = True
End If
End If
End If
If Len(sIniFileContent) > 0 Then sIniFileContent = sIniFileContent & vbCrLf
If sNewLine = "" Then
sIniFileContent = sIniFileContent & sLine
Else
sIniFileContent = sIniFileContent & sNewLine
End If
Next i
SectionDoesNotExist:
'if not found, add it to the end
If bSectionExists = False Then
If Len(sIniFileContent) > 0 Then sIniFileContent = sIniFileContent & vbCrLf
sIniFileContent = sIniFileContent & "[" & sSection & "]"
End If
If bKeyAdded = False Then
sIniFileContent = sIniFileContent & vbCrLf & sKey & "=" & sValue
End If
'Write to the ini file the new content
Call OverwriteTxt(sIniFile, sIniFileContent)
Ini_WriteKeyVal = True
Error_Handler_Exit:
On Error Resume Next
Exit Function
Error_Handler:
MsgBox "Fehler im Modul 'Ini_WriteKeyVal'" & vbCrLf & vbCrLf & _
"Error Number: " & err.number & vbCrLf & _
"Error Source: Ini_WriteKeyVal" & vbCrLf & _
"Error Description: " & err.Description & _
Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
, vbOKOnly + vbCritical, "An Error has Occurred!"
Resume Error_Handler_Exit
End Function
Sub TestReadKey()
MsgBox "INI File: " & ThisWorkbook.Path & "\Tierhotel.ini" & vbCrLf & _
"Section: SETTINGS" & vbCrLf & _
"Section Exist: " & bSectionExists & vbCrLf & _
"Key: License" & vbCrLf & _
"Key Exist: " & bKeyExists & vbCrLf & _
"Key Value: " & Ini_ReadKeyVal(ThisWorkbook.Path & "\Tierhotel.ini", "SETTINGS", "License")
'You can validate the value by checking the bSectionExists and bKeyExists variable to ensure they were actually found in the ini file
End Sub
Sub TestWriteKey()
If Ini_WriteKeyVal(ThisWorkbook.Path & "\Tierhotel.ini", "SETTINGS", "License", "JBXR-HHTY-LKIP-HJNB-GGGT") = True Then
MsgBox "The key was written"
Else
MsgBox "An error occurred!"
End If
End Sub

Excel VBA INI Datei schreiben / lesen

Excel VBA INI Datei schreiben / lesen

Visual Basic-Quellcode

matze.tele schrieb:

Visual Basic-Quellcode

matze.tele schrieb:

Visual Basic-Quellcode

C-Quellcode

VB.NET-Quellcode

volti schrieb:

Visual Basic-Quellcode

VB.NET-Quellcode

VB.NET-Quellcode

Visual Basic-Quellcode

Tags

Ähnliche Themen

8 Benutzer haben hier geschrieben