unlesbares log-File erstellen

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 in allgemeinem, öffentlichen Verzeichnis, eine Datei je User
strDatei = "C:\Users\Public\Test\Data" & "\LogBuch_" & Environ("Username") & "_" _
& Left(.Name, InStrRev(.Name, ".") - 1) & ".txt"
'Logbuch im Verzeichnis der Datei, eine Datei je User
strDatei = .Path & "\LogBuch_" & Environ("Username") & "_" _
& Left(.Name, InStrRev(.Name, ".") - 1) & ".txt"
'Logbuch im Verzeichnis des Users
strDatei = Environ("USERPROFILE") & "\LogBuch_" & Environ("Username") & "_" _
& Left(.Name, InStrRev(.Name, ".") - 1) & ".txt"
'Logbuch im Verzeichnis der Datei, eine Datei für alle User
strDatei = .Path & "\LogBuch_" & "_" & Left(.Name, InStrRev(.Name, ".") - 1) & ".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