How to make an external log using Excel VBA?

前端 未结 3 1627
说谎
说谎 2021-01-02 07:38

The code has been updated to reference the changes below.

This log system create an external document for Excel called Log.txt, it will create a line in the log.txt

3条回答
  •  借酒劲吻你
    2021-01-02 08:36

    one year later i modified the Code from Matthew - now it tracks changes by copy/paste or tracking down the mouse too, thanks Matthew for the good idea!:

    'Paste this into a Module:
    
    Option Explicit
    
    'SheetArray to hold the old values before any change is made
    Public aSheetArr() As Variant
    
    
    'helperfunctions for last row and last col of a given sheet:
    
    Function LastRow(sh As Worksheet)
    'get last row of a given worksheet
    sh.EnableAutoFilter = False
        On Error Resume Next
        LastRow = sh.Cells.Find(What:="*", _
                                After:=sh.Range("A1"), _
                                LookAt:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByRows, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False).Row
        On Error GoTo 0
    End Function
    
    
    Function LastCol(sh As Worksheet)
    'get last col of a given worksheet
    sh.EnableAutoFilter = False
        On Error Resume Next
        LastCol = sh.Cells.Find(What:="*", _
                                After:=sh.Range("A1"), _
                                LookAt:=xlPart, _
                                LookIn:=xlFormulas, _
                                SearchOrder:=xlByColumns, _
                                SearchDirection:=xlPrevious, _
                                MatchCase:=False).Column
        On Error GoTo 0
    End Function
    
    
    'Paste this into the workbook_Open method of your workbook (initializing the sheetarray)
    Option Explicit
    
    Private Sub Workbook_Open()
    Dim lCol As Long
    Dim lRow As Long
    
    Dim wks As Worksheet
    Set wks = Sheets(1)
    
    lCol = LastCol(wks)
    lRow = LastRow(wks)
    
    
    aSheetArr = wks.Range(wks.Cells(1, 1), wks.Cells(lRow, lCol)) 'read the Range from the whole Sheet into the array
    
    
    End Sub
    
    
    
    'Paste this into the tablemodule - area where you want to log the changes:
    
    
    Option Explicit
    Private Sub Worksheet_Change(ByVal Target As Range)
    'logging all the changes in a worksheet - also the copy/past's and track down's over ceveral cells
    
        Dim sLogFileName As String, nFileNum As Long, sLogMessage As String, r As Long
    
    
    sLogFileName = ThisWorkbook.Path & Application.PathSeparator & "Log.txt"
    
    
     'Check all cells for changes, excluding D4 D5 E5 M1 etc
    For r = 1 To Target.Count
        'compare each cell with the values from the old cell
        If Target(r).value <> aSheetArr(Target(r).Row, Target(r).Column) Then
             ' Check if we have an error
            If Err.Number = 13 Then
                PreviousValue(r) = 0
    
            End If
             ' Turn off error handling
             'On Error GoTo 0
             'log data into .txt file
            sLogMessage = Now & " " & Application.UserName & " changed cell " & Target(r).Address _
            & " in " & ActiveSheet.Name & " from " & "'" & aSheetArr(Target(r).Row, Target(r).Column) & "' to '" & Target(r).value & "'"
    
            'set the values in the array to the changed ones
            aSheetArr(Target(r).Row, Target(r).Column) = Target(r).value
    
            nFileNum = FreeFile ' next file number
            Open sLogFileName For Append As #nFileNum ' create the file if it doesn't exist
            Print #nFileNum, sLogMessage ' append information
            Close #nFileNum ' close the file
        End If
    Next r
    End Sub
    

提交回复
热议问题