Arbeiten mit .txt Dateien im Netzwerk

Hallo Gemeinde,
es geht um das Arbeiten mit .txt-Dateien.
In einem Netzwerk hat jeder Anwender eine VBA-Anwendung, in der er fast täglich eine Zusammenfassung seiner geleisteten Arbeit verfasst. Diese erhält eine einmalige Vorgangsnummer, gefolgt von den einzelnen Aktivitäten.
Die Vorgangsnummer besteht aus :
- einer 8-stelligen Personalnummer &
- dem heutigigen Datum (190308) &
- einer 14-stelligen Zahl &
- einem A
Beispiel : Vorgangsnummer#heute habe ich fast nichts getan#jetzt mache ich Feierabend#
Diese Zusammenfassung hat der Anwender dann in eine .txt-Datei (Gesamt.txt)zu übertragen, in der alle Zusammenfassungen aller Anwender eingetragen werden.
Er hat auch eine eigene .txt-Datei (Eigene.txt), in die seine Zusammenfassung speichern kann.
Jetzt darf es aber nicht sein, dass der gleiche Anwender unter dem gleichen Datum (also Kombination aus Personalnummer und Datum) eine zweite Zusammenfassung überträgt.
Meine Überlegung ist, dass ich beim Übertragen zunächst prüfen muss, ob die Gesamt.txt von einem anderen Anwender geöffnet wurde.
Wenn die Gesamt.txt frei ist, dann durchsuche ich sie nach der Kombination (Personalnummer und Datum) bis zum Ende. Wenn keine Übereinstimmung gefunden wurde, wird die Zusammenfassung mit Append hinten an die Gesamt.txt rangehangen.
Habt ihr dazu eine Idee und eine Routine?
Es soll auch nicht sein, dass die Gesamt.txt zwischen der Prüfung (ob sie frei ist) und dem Durchsuchen geschlossen wird, sonst könnte (theoretisch) in dieser Millisekunde ein Anderer auf die Gesamt.txt zugreifen.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub testT() Dim strText As String Dim lngFn As Long, AnZEinTrag As Long, A As Long Dim strPathAndFileName As String Dim vntA As Variant Dim MeinePersonalNr As String, MeineZahl As String Dim MeinTXT As String, NeuerText As String Dim Fund As Boolean MeinePersonalNr = "44666257" 'Personalnummer MeineZahl = "12345735401234A" 'einer 14-stelligen Zahl und ein A MeinTXT = "Was ich schon immer mal sagen wollte" 'Mein Text 'Mein Pfad strPathAndFileName = "C:\Neuer Ordner\Text.txt" 'Pfad zur Datei Fund = False MeinePersonalNr = MeinePersonalNr & Format(Date, "ddmmyy") & MeineZahl If Dir$(strPathAndFileName) "" Then lngFn = FreeFile Open strPathAndFileName For Binary As lngFn strText = Space(LOF(lngFn)) Get lngFn, 1, strText Close lngFn 'nach dem lesen löschen, kann somit nicht verwendet werden Kill (strPathAndFileName) AnZEinTrag = CountChar(strText, vbCr) vntA = Split(strText, vbCr) For A = 0 To AnZEinTrag vntA(A) = Replace(vntA(A), vbCr, "") vntA(A) = Replace(vntA(A), vbCrLf, "") If InStr(vntA(A), MeinePersonalNr) > 0 Then vntA(A) = Left$(vntA(A), InStr(vntA(A), "#")) & MeinTXT Fund = True End If NeuerText = NeuerText & vntA(A) & vbCr Next A If Fund = False Then NeuerText = NeuerText & MeinePersonalNr & "#" & MeinTXT & vbCr End If NeuerText = Left(NeuerText, Len(NeuerText) - 1) lngFn = FreeFile Open strPathAndFileName For Binary As lngFn Put lngFn, 1, NeuerText 'Datei zurückschreiben Close lngFn Else MsgBox "wird gerade verwendet!", vbCritical, "Datei nicht vorhanden!" End If End Sub Function CountChar(ByVal SourceString As String, ByVal strChar As String) As Long CountChar = Len(SourceString) - Len(Replace(SourceString, strChar, "")) End Function

Hallo,
aber wen es unbedingt sein muss, hier eine 2. Möglichkeit.
Die Datei wird vor dem öffnen umbenannt, somit ist die Original währenddessen
nicht vorhanden und kann somit auch nicht benutzt werden, am Schluss bekommt diese wieder Ihren richtigen Namen.


Sub testT()
Dim strText As String
Dim lngFn As Long, AnZEinTrag As Long, A As Long
Dim strPathAndFileName As String
Dim vntA As Variant
Dim MeinePersonalNr As String, MeineZahl As String
Dim MeinTXT As String, NeuerText As String
Dim Fund As Boolean
Dim fso As Object, f1 As Object
MeinePersonalNr = "44666257" 'Personalnummer
MeineZahl = "12345735401234A" 'einer 14-stelligen Zahl und ein A
MeinTXT = "Was ich schon immer mal sagen wollte 2" 'Mein Text
'Mein Pfad
strPathAndFileName = "C:\Dokumente und Einstellungen\ts\Eigene Dateien\1 Forum\TextTXT\Text. _
txt" 'Pfad zur Datei
Fund = False
MeinePersonalNr = MeinePersonalNr & Format(Date, "ddmmyy") & MeineZahl
If Dir$(strPathAndFileName)  "" Then
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.GetFile(strPathAndFileName)
f1.Move (strPathAndFileName & "besetzt")
lngFn = FreeFile
Open strPathAndFileName & "besetzt" For Binary As lngFn
strText = Space(LOF(lngFn))
Get lngFn, 1, strText
Close lngFn
'nach dem lesen löschen, kann somit nicht verwendet werden
Kill (strPathAndFileName & "besetzt")
AnZEinTrag = CountChar(strText, vbCr)
vntA = Split(strText, vbCr)
For A = 0 To AnZEinTrag
If AnZEinTrag = 0 Then Exit For
vntA(A) = Replace(vntA(A), vbCr, "")
vntA(A) = Replace(vntA(A), vbCrLf, "")
vntA(A) = Replace(vntA(A), Chr(10), "")
vntA(A) = Replace(vntA(A), Chr(13), "")
If InStr(vntA(A), MeinePersonalNr) > 0 Then
vntA(A) = Left$(vntA(A), InStr(vntA(A), "#")) & MeinTXT
Fund = True
End If
If vntA(A) > "" Then
NeuerText = NeuerText & vntA(A) & vbCrLf
End If
Next A
If Fund = False Then
NeuerText = NeuerText & MeinePersonalNr & "#" & MeinTXT & vbCrLf
End If
NeuerText = Left(NeuerText, Len(NeuerText) - 1)
lngFn = FreeFile
Open strPathAndFileName & "besetzt" For Binary As lngFn
Put lngFn, 1, NeuerText 'Datei zurückschreiben
Close lngFn
Set fso = CreateObject("Scripting.FileSystemObject")
Set f1 = fso.GetFile(strPathAndFileName & "besetzt")
f1.Move (strPathAndFileName)
Set fso = Nothing
Set f1 = Nothing
Else
MsgBox "wird gerade verwendet!", vbCritical, "Datei nicht vorhanden!"
End If
End Sub
Function CountChar(ByVal SourceString As String, ByVal strChar As String) As Long
CountChar = Len(SourceString) - Len(Replace(SourceString, strChar, ""))
End Function

Gruß
Tino

Beliebteste Forumthreads (12 Monate)

Arbeiten mit .txt Dateien im Netzwerk

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

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread