Log-File für vorgenommene Änderungen
04.11.2016 10:14:19
Oliver
folgendes Skript aus dem Forum hier hat mir schon gute Dienste geleistet. Der Ursprüngliche Post ist vom 05.04.2012.
Das Skript habe ich so abgewandelt, das es eine Log-Datei pro Tag erstellt.
Jetzt möchte ich gern das zusätzlich zur täglichen Log-Datei noch eine zweite Log-Datei erstellt wird in der alle Änderungen fortlaufend protokolliert werden. Das bekomme ich irgendwie nicht hin.
Hat jemand eine Idee dazu?
LG
Oliver
****************************************************************************************************
Option Explicit
Dim mstrOld(1 To 1000, 1 To 16384) As String
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row > 1000 Then Exit Sub
Dim strDatei As String, strText As String
Dim strZeit As String, strUser As String, strZelle As String, strOld As String, strNeu As _
String
Dim intFile As Integer, rng As Range
Const strDELIM As String = "|" 'Logfile Delimiter - ggf. anpassen
Const lenUser As Integer = 15 'Anzahl Zeichen für Username
Const lenAdresse As Integer = 6 'Anzahl Zeichen für Zelladress
Const lenWert As Integer = 10 'min. Anzahl Zeichen für Wert alt und neu
Const FormatZeit As String = "YYYY-MM-DD hh:mm:ss" 'Format für Zeitstempel
intFile = FreeFile
With ThisWorkbook
'Logbuch im Verzeichnis der Datei, eine Datei für alle User
strDatei = .Path & "\LogBuch_" & "_" & "Test_Log" & "_" & Format(Now, "DD.MM.YYYY") & ". _
txt"
End With
Open strDatei For Append As #intFile
If LOF(intFile) = 0 Then
'Texte in Titelzeile
With Application.WorksheetFunction
strZeit = "Zeitstempel"
strZeit = strZeit & VBA.Space(.Max(0, Len(FormatZeit) - Len(strZeit)))
strUser = "User"
strUser = strUser & VBA.Space(.Max(0, lenUser - Len(strUser)))
strZelle = "Zelle"
strZelle = strZelle & VBA.Space(.Max(0, lenAdresse - Len(strZelle)))
strOld = "alter-Wert"
strOld = strOld & VBA.Space(.Max(0, lenWert - Len(strOld)))
strNeu = "neuer-Wert"
strNeu = strNeu & VBA.Space(.Max(0, lenWert - Len(strNeu)))
strText = strZeit & strDELIM & strUser & strDELIM & strZelle & strDELIM & _
strOld & strDELIM & strNeu & strDELIM
End With
Print #intFile, strText
'Text für Trennzeile ("-" und Trennzeichen)
strText = String(Len(strZeit), "-") & strDELIM & String(Len(strUser), "-") & strDELIM _
_
& String(Len(strZelle), "-") & strDELIM _
& String(Len(strOld), "-") & strDELIM & String(Len(strNeu), "-") & strDELIM
Print #intFile, strText
End If
For Each rng In Target.Cells
If rng.Value mstrOld(rng.Row, rng.Column) Then
With Application.WorksheetFunction
strZeit = Format(Now, "YYYY-MM-DD hh:mm:ss")
strUser = Environ("username")
strUser = strUser & VBA.Space(.Max(0, lenUser - Len(strUser)))
strZelle = VBA.Replace(rng.Address, "$", "")
strZelle = strZelle & VBA.Space(.Max(0, lenAdresse - Len(strZelle)))
strOld = mstrOld(rng.Row, rng.Column)
strOld = strOld & VBA.Space(.Max(0, lenWert - Len(strOld)))
strNeu = IIf(rng.Value = "", "#gelöscht#", rng.Value)
strNeu = strNeu & VBA.Space(.Max(0, lenWert - Len(strNeu)))
strText = strZeit & strDELIM & strUser & strDELIM & strZelle & strDELIM & _
strOld & strDELIM & strNeu & strDELIM
End With
Print #intFile, strText
End If
Next
Close #intFile
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row > 1000 Then Exit Sub
Dim rng As Range
For Each rng In Target.Cells
mstrOld(rng.Row, rng.Column) = rng.Value
Next
End Sub