Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: TXT-Datei mit Status über Dateiöffnung erstellen

TXT-Datei mit Status über Dateiöffnung erstellen
18.09.2024 11:24:42
Lutz
Hallo,
ich habe ein Problem mit einer Exceldatei (liegt auf Firmenserver) zu der mehrere Mitarbeiter Zugriff haben.

Problem:
Normalerweise zeigt Excel an, wenn die Datei von einer anderen Person geöffnet ist und bietet das "schreibgeschützte" Öffnen an.
Allerdings scheint es a.G. der Servereinstellung (hierzu habe ich weder Rechte noch Einfluss) so zu sein, dass diese Meldung ausbleibt und die Datei 2x mit Schreibrecht geöffnet werden kann. Dies führt zwangsläufig zu Fehlern im Datenbestand und man erfährt davon Nichts.

Mein Lösungsgedanke:
- TXT-Datei im Dokumentenpfad ablegen
- in der TXT-Datei steht der Wert "gesperrt" oder "verfügbar"

- beim Öffnen der Excel-Datei wird geprüft, ob in der TXT-Datei der Wert "gesperrt" (Excel-Datei in Benutzung) oder "verfuegbar" (Excel-Datei geschlossen) steht
--> wenn "gesperrt" dann soll eine MsgBox mit entsprechendem Hinweis erfolgen

- beim Öffnen der Excel-Datei in die TXT-Datei der Wert "gesperrt" geschrieben
- beim Schließen der Excel-Datei wird in die TXT-Datei der Wert "verfuegbar" geschrieben

Liest sich sicherlich kompliziert und ich hab versucht mein Problem darzulegen
Hättet Ihr eine Lösung für mich wie ich dies in VBA umsetze oder eine andere Lösung für mein Problem.
Anzeige

6
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: TXT-Datei mit Status über Dateiöffnung erstellen
18.09.2024 12:53:07
UweD
Hallo

versuch es mal so

Code muss in den Codebereich von "DieseArbeitsmappe"



Private Sub Workbook_Open()
Dim filePath As String
Dim fileContent As String
Dim fileNum As Integer

' Pfad zur Textdatei
filePath = ThisWorkbook.Path & "\Status.txt"

' Datei öffnen und auslesen
fileNum = FreeFile
Open filePath For Input As fileNum
fileContent = Input$(LOF(fileNum), fileNum)
Close fileNum

' Inhalt der Textdatei prüfen
'MsgBox fileContent
If fileContent = "verfügbar" Then
'mach was
ElseIf fileContent = "gesperrt" Then
'mach was anderes
MsgBox fileContent
End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim filePath As String
Dim fileNum As Integer
Dim textToWrite As String

' Pfad zur Textdatei
filePath = ThisWorkbook.Path & "\Status.txt"

' Text, der in die Datei geschrieben wird
textToWrite = "verfügbar"

' Datei zum Schreiben öffnen und Text reinschreiben
fileNum = FreeFile
Open filePath For Output As fileNum
Print #fileNum, textToWrite
Close fileNum
End Sub

LG UweD
Anzeige
AW: TXT-Datei mit Status über Dateiöffnung erstellen
18.09.2024 19:23:15
volti
Hallo Lutz,

hier noch eine Idee. Mit der klassischen Ini-Version.....

Allerdings funktioniert das so noch nicht ganz. Beim Öffnen 'gesperrt' schreiben mag ja noch ok sein, wenn ich aber die zweite oder dritte geöffnete Datei mit Hinweis "Datei gesperrt" versehe und sie dann wieder schließe, würde ja in die Txt-Datei beim Close-Event wieder "verfügbar" geschrieben, obwohl ja immer noch die zu erst geöffnete Datei auf ist.

Ich denke, da muss man mit Zähler hoch zählen oder irgendwas anderes arbeiten. Da hatte ich noch keine Lust zu.
Und da ist diese Ini-Version m.E. ideal, da man sehr schnell Lesen, Zähler hoch, Schreiben, Lesen...kann.

PS: Ggf. TEMP-Verzeichnis durch Thisworkbook.Path ersetzen....

Code:


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 = Environ$("TEMP") & "\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) SetGetInidaten "Datei", "Status", "verfügbar" End Sub Sub Workbook_Open() Select Case SetGetInidaten("Datei", "Status") Case "verfügbar" Case Else MsgBox "Die Datei ist schreibgeschützt!" End Select SetGetInidaten "Datei", "Status", "gesperrt" End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz
Anzeige
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


Anzeige
AW: TXT-Datei mit Status über Dateiöffnung erstellen
19.09.2024 18:15:49
volti
Hallo Lutz,

ja so ähnlich hatte ich mir das gedacht.

Wenn ich mir das jetzt so anschaue:
Das ist doch nur eine technische Prüfung, die der User nicht mitkriegt oder nicht wissen muss, was 0, 1 oder 2 bedeuten.

Könnte es da nicht reichen, einfach nur den Zähler zu nutzen und bei =1 ist die Datei frei, bei >1 wird eine Meldung ausgegeben?

PS: Die Funktionen sind Funktionen aus der Windows-API. Gibt es da die Probleme auf dem Mac?

Hier eine (ungetestete) Idee:

Code:


Sub Workbook_BeforeClose(Cancel As Boolean) Dim OpenZ As Integer 'liest den Zähler aus der INI und reduziert Zähler um 1 OpenZ = Val(SetGetInidaten("Datei", "Zähler")) - 1 'schreibt neuen Zähler SetGetInidaten "Datei", "Zähler", CStr(OpenZ) End Sub Sub Workbook_Open() Dim OpenZ As Integer 'liest den Zähler aus der INI und erhöht ihn um 1 OpenZ = Val(SetGetInidaten("Datei", "Zähler")) + 1 'schreibt neuen Zähler SetGetInidaten "Datei", "Zähler", CStr(OpenZ) If OpenZ > 1 Then MsgBox "Die Datei ist schreibgeschützt!", vbCritical End Sub

_________________________
viele Grüße aus Freigericht 😊
Karl-Heinz
Anzeige
AW: TXT-Datei mit Status über Dateiöffnung erstellen
20.09.2024 18:21:16
Lutz
Hallo Karl-Heinz,
ja dein letzter VBA-Code funktioniert 1a und du hast recht 0,1,2 .. genügt vollkommen. Jetzt muss ich nur noch eine Fehlerroutine einbauen, falls jemand so "clever" ist und die txt-Datei löscht (solche Leute gibt es).

Bzgl. der Code-Ausführung auf dem Mac liegt es in der Tat an der Windows-Api (kernel32). Das ist aber weniger tragisch, da ich gewohnt bin, dass nicht alles mit dem Mac kompatibel ist.

Beste Grüße und Danke
Lutz
Anzeige
AW: TXT-Datei mit Status über Dateiöffnung erstellen
18.09.2024 21:51:31
jojogar
Hallo Lutz,

erstmal wäre die Frage, ob die Arbeitsmappe für gemeinsame Bearbeitung freigegeben ist und ob eine gemeinsame Bearbeitung erwünscht ist. Das ist (glaube ich) nur bis Excel 2016 möglich.
Mit dieser Prozedur kannst Du anzeigen lassen, ob die Arbeitsmappe bereits geöffnet und/oder freigegeben ist.
Kopiere die Sub in das KlassenModul "Diese Arbeitsmappe" (ThisWorkbook). Sie wird dann jeweils beim Öffnen der Mappe ausgeführt.

Private Sub Workbook_Open()
Dim filePath As String
Dim wb As Workbook
Dim fileOpen As Boolean
Dim isShared As Boolean

' Pfad zur Arbeitsmappe
filePath = ThisWorkbook.FullName

On Error Resume Next
' Versuchen, die Arbeitsmappe im schreibgeschützten Modus zu öffnen
Set wb = Workbooks.Open(filePath, ReadOnly:=True, Notify:=False
' ggf. auch mit ReadOnly:=False testen


If Err.Number > 0 Then
' Wenn ein Fehler auftritt, ist die Datei wahrscheinlich schon geöffnet
fileOpen = True
Else
' Die Datei wurde erfolgreich geöffnet, prüfen ob sie freigegeben ist
fileOpen = False
isShared = wb.MultiUserEditing

' Schließe ggf. die Arbeitsmappe, ohne Änderungen zu speichern
' wb.Close SaveChanges:=False
End If

On Error GoTo 0

If fileOpen Then
MsgBox "Die Arbeitsmappe ist bereits von einem anderen Benutzer geöffnet."
Else
If isShared Then
MsgBox "Die Arbeitsmappe ist nicht geöffnet, aber sie ist für gemeinsame Bearbeitung freigegeben."
Else
MsgBox "Die Arbeitsmappe ist nicht geöffnet und nicht für gemeinsame Bearbeitung freigegeben. Du kannst sie bearbeiten."
End If
End If
End Sub


----------------------------+
Grüße,
jojogar
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Anzeige
Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige