AW: TXT-Datei mit Status über Dateiöffnung erstellen
19.09.2024 17:29:14
Lutz
Zunächst vielen Dank für Eure Beiträge zu meiner Anfrage.
Letztendlich habe ich den Code von Karl-Heinz (volti) genutzt, da dieser auf Anhieb funkltionierte und bin ihm zugleich dankbar für den Tipp mit dem Zähler. Das Problem mit dem mehrfachen öffnen hatte ich noch nicht auf dem Schirm.
Ich habe den Code dahingehend erweitert, dass in der INI ein Wert "Zähler" angelegt wird und dieser beim Öffnen und Schließen ausgewertet wird.
Ich füge den Code hier mal an und vielleicht sagt ihr OK oder das kann man schöner lösen.
Ein Problem hat sich noch aufgetan, welches ich aber erst habe wenn unsere Firma die Office-Version (aktuell 2019 und nicht wie zunächst geschrieben 2016) ändert.
Dies ist auch der Grund warum ich erst jetzt auf die Code-Beispiele reagieren konnte.
In der Firma wird Excel 2019 genutzt, wo der Code funktioniert und privat habe ich Office365 (Windows / Mac) wo der Code mit Fehlern abbricht.
Also nochmals vielen Dank an Alle
Lutz
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
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 * 50, l As Integer
sPfad = ThisWorkbook.Path & "\Status.txt"
If sDaten > "" Then
WritePrivateProfileStringA sBereich, sItem, sDaten, sPfad
Else
l = GetPrivateProfileStringA(sBereich, sItem, "none", sTxt, 50, sPfad)
SetGetInidaten = Left$(sTxt, l)
End If
End Function
Sub Workbook_BeforeClose(Cancel As Boolean)
Dim OpenZ As Integer
'liest den Zähler aus der INI
OpenZ = SetGetInidaten("Datei", "Zähler")
'reduziert Zähler um 1
OpenZ = OpenZ - 1
'schreibt neuen Zähler
SetGetInidaten "Datei", "Zähler", CStr(OpenZ)
'prüft den NEUEN Zähler. Wenn dieser > 0 dann ist noch eine weitere Version der Datei offen und der Status wird NICHT geändert
If OpenZ = 0 Then SetGetInidaten "Datei", "Status", "verfügbar"
End Sub
Sub Workbook_Open()
Dim OpenZ As Integer
'liest den Zähler aus der INI
OpenZ = SetGetInidaten("Datei", "Zähler")
'erhöht Zähler um 1
OpenZ = OpenZ + 1
'schreibt neuen Zähler
SetGetInidaten "Datei", "Zähler", CStr(OpenZ)
Select Case SetGetInidaten("Datei", "Status")
Case "verfügbar"
Case Else
MsgBox "Die Datei ist schreibgeschützt!"
End Select
SetGetInidaten "Datei", "Status", "gesperrt"
End Sub