860to864: Änderungen und Benutzer in Datei speichern

Schönen guten Tag zusammen,
heute beschäftigt mich folgendes Problem:
eine im Netzwerk genutze Datei mit einer großen Anzahl - sagen wir mal leicht "manipulierbaren"- Informationen liegt auf unserem Server. Um die Dateistruktur und die ausgebenen Informationen möglichst valide zu halten, möchte ich nun erreichen, dass in einer gesonderten Datei die Änderungen, die an der Datei vorgenommen wurden, und der Benutzer, der etwas geändert hat, abgespeichert werden.
Dadurch will ich eine höhere Transparenz der Nutzung erreichen. Hat jemand von euch eine Idee, wie man die Umsetzung realisieren könnte?
Ich danke euch bereits vielmals im Voraus und wünsche euch noch einen schönen Tag!
Viele Grüße
Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim strDatei As String, strText As String, intFile As Integer intFile = FreeFile strDatei = "c:\temp\logbuch.txt" strText = Format(Now, "YYMMDD_hhmmss") _ & vbTab & Environ("username") _ & vbTab & Sh.Name _ & vbTab & Target.Address _ & vbTab & Target.Value Open strDatei For Append As intFile Print #intFile, strText Close intFile End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim strDatei As String, strText As String, intFile As Integer, c As Range intFile = FreeFile strDatei = "c:\temp\LogBuch_" & Replace(ThisWorkbook.Name, ".xls", "") & ".txt" Open strDatei For Append As intFile For Each c In Target.Cells strText = Format(Now, "YYMMDD_hhmmss") _ & vbTab & Environ("username") _ & vbTab & Sh.Name _ & vbTab & c.Address _ & vbTab & c.Value Print #intFile, strText Next c Close intFile End Sub

Option Explicit Public log As String Private Sub Workbook_BeforeClose(Cancel As Boolean) Dim aw aw = MsgBox("Sollen Ihre Änderungen in """ & ThisWorkbook.Name & """ gespeichert werden?" _ , vbExclamation + vbYesNoCancel) If aw = vbCancel Then Cancel = True Exit Sub End If 'hier der Code, der wirklich nur beim Schließen ausgeführt werden soll If aw = vbNo Then ThisWorkbook.Saved = True If aw = vbYes Then ThisWorkbook.Save End Sub Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean) Dim ff As Integer ff = FreeFile Cancel = True Application.EnableEvents = False If SaveAsUI Then MsgBox "Die Datei darf nicht unter anderem Namen gespeichert werden!" Else On Error Resume Next Me.Save If Err.Number > 0 Then MsgBox Err.Description, vbCritical, "Fehler" Else Me.Saved = True Open ThisWorkbook.Path & "\log.csv" For Append As #ff Print #ff, log; Close #ff log = "" End If End If Application.EnableEvents = True End Sub Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) log = log & _ Date & ";" & Environ("USERNAME") & ";""" & Sh.Name & """;""" & Target.Address(0, 0) & """;""" & _ WorksheetFunction.Substitute(Target.Text, Chr(34), "''") & """" & vbLf End Sub

Hallo Rudi, hallo Andreas,
ich weiß nicht, das permanente Öffnen und Schließen einer (temporären) Datei verlangsamt doch sehr die Leistung (ich sag jetzt nicht Performance!).
Aber mein Code hat nicht ganz funktioniert, hier nochmal eine bessere Version:


Option Explicit
Public log As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim aw
If Not Me.Saved Then
aw = MsgBox("Sollen Ihre Änderungen in """ & ThisWorkbook.Name & """ gespeichert werden?" _
, vbExclamation + vbYesNoCancel)
If aw = vbCancel Then
Cancel = True
Exit Sub
End If
'hier der Code, der wirklich nur beim Schließen ausgeführt werden soll
If aw = vbNo Then ThisWorkbook.Saved = True
If aw = vbYes Then SaveWB
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Cancel = True
If SaveAsUI Then
MsgBox "Die Datei darf nicht unter anderem Namen gespeichert werden!"
Else
SaveWB
End If
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
log = log & _
Format(Now, "dd.mm.yy hh:mm") & ";" & Environ("USERNAME") & ";""" & Sh.Name & """;""" &  _
Target.Address(0, 0) & """;""" & WorksheetFunction.Substitute(Target.Text, Chr(34), "''") & """" & vbLf
End Sub
Private Sub SaveWB()
Dim ff As Integer
Dim fn As String
fn = Left(Me.FullName, Len(Me.FullName) - 4) & "_LOG.csv"
Application.EnableEvents = False
On Error Resume Next
ThisWorkbook.Save
If Err.Number > 0 Then
MsgBox Err.Description, vbCritical, "Fehler"
Else
Me.Saved = True
ff = FreeFile
Open fn For Append As #ff
If Err.Number > 0 Then
MsgBox Err.Description, vbCritical, "Fehler beim sichern der Logdatei"
Else
Print #ff, log;
Close #ff
log = ""
End If
End If
Application.EnableEvents = True
End Sub

Gruß Matthias

Beliebteste Forumthreads (12 Monate)

860to864: Änderungen und Benutzer in Datei speichern

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread