Для использования подобного кода записи логов необходимо скопировать (перетащив мышкой) модуль класса LogRecorder из прикреплённого файла в ваш файл. Sub ПримерИспользованияКласса_LogRecorder() ' создаём новый экземпляр лог-рекордера Dim LR As LogRecorder: Set LR = New LogRecorder ' задаём имя файла для лога (указываем полный путь) LR.LogFileFullName = ThisWorkbook.Path & "\common.log" LR.OpenLog ' открываем лог (очистка файла + запись стартовой строки) For i = 1 To 10 ' здесь ваш код ... ' заносим запись в лог LR.AddRecord "Событие " & i, "Информация " & i, 1 If i Mod 3 = 0 Then ' i делится на 3 без остатка ' добавляем запись, до и после неё вставляем строку-разделитель LR.AddRecord "Значение " & i & " делится на 3 без остатка", _ "дополнительная проверка", 2, LOG_SEPARATOR_BEFORE_AND_AFTER End If Next i LR.AddRecord "Цикл завершен", "Проверено 10 чисел", 1, LOG_SEPARATOR_AFTER LR.CloseLog ' закрываем лог (очистка буфера + запись конечной строки) ' LR.Show ' запуск текстового файла с логом (для просмотра End Sub Можно при добавлении записей в лог указать уровень записей - чтобы выделять отдельные записи отступом слева, как на этом скриншоте: http://ExcelVBA.ru/pictures/20110829-cd9-96kb.jpg Кроме того, можно задать максимальное значение буфера лога (запись непосредственно в файла происходит не при каждом выполнении команды AddRecord, а только при превышении размера буфера, принудительном сохранении лога опцией ForceSavingLog=TRUE, а также при сохранении лога командой SaveLog, и при закрытии лога методом CloseLog ) Результатом работы этого кода будет создание файла с именем common.log в той же папке, где расположен файл Excel с макросом:
Для создания сразу нескольких логов удобно использовать дополнительный модуль класса LogRecorders (также присутствует в прикреплённом файле) Код модуля класса LogRecorder: Public Enum LOG_SEPARATOR_TYPE ' добавление разделителей в лог LOG_SEPARATOR_NONE = 0 LOG_SEPARATOR_BEFORE = 1 LOG_SEPARATOR_AFTER = 2 LOG_SEPARATOR_BEFORE_AND_AFTER = 3 End Enum Public LogFileFullName As String Public LogIndex As LOG_TYPE Public index As Long Public Buffer As String Public maxLogSizeBeforeSave As Long Public LogSeparator As String Private Sub Class_Terminate() Buffer = "" 'CloseLog End Sub Private Sub Class_Initialize() LogSeparator = String(50, "=") & vbNewLine If maxLogSizeBeforeSave = 0 Then maxLogSizeBeforeSave = 5000 End Sub Sub SaveLog() If AddIntoTXTfile(LogFileFullName, Buffer) Then Buffer = Empty Else Debug.Print "Ошибка записи лога в файл " & LogFileFullName End If End Sub Sub OpenLog() Buffer = "" ' очистка буфера SaveTXTfile LogFileFullName, "" ' сохранение пустого файла AddRecord "Starting Log Record...", , , LOG_SEPARATOR_BEFORE, True ' стартовая запись End Sub Sub CloseLog() AddRecord "Finishing Log Record...", , , LOG_SEPARATOR_AFTER, True ' конечная запись Buffer = "" ' очистка буфера End Sub Sub Show() 'On Error Resume Next Path$ = Chr(34) & LogFileFullName & Chr(34) CreateObject("wscript.shell").Run Path$ End Sub Sub AddRecord(ByVal EventX As String, Optional ByVal Info As String, _ Optional ByVal Level As Integer = 0, _ Optional ByVal LogSeparatorType As LOG_SEPARATOR_TYPE = LOG_SEPARATOR_NONE, _ Optional ByVal ForceSavingLog As Boolean = False) txt = String(160, " "): Mid(txt, 1) = Left(EventX, 45): Mid(txt, 51) = Info txt = String(Level, vbTab) & Format(Now, "YYYY-MM-DD HH:NN:SS") & String(2, vbTab) & Trim(txt) & vbNewLine txt = IIf(LogSeparatorType = LOG_SEPARATOR_BEFORE Or LogSeparatorType = LOG_SEPARATOR_BEFORE_AND_AFTER, LogSeparator, "") & _ txt & IIf(LogSeparatorType = LOG_SEPARATOR_AFTER Or LogSeparatorType = LOG_SEPARATOR_BEFORE_AND_AFTER, LogSeparator, "") Buffer = Buffer & txt If ForceSavingLog Or (Len(Buffer) > maxLogSizeBeforeSave) Then SaveLog End Sub Sub SaveLogAs(ByVal filename As String, Optional ByVal Overwrite As Boolean = False) On Error Resume Next txt = ReadTXTfile(LogFileFullName) If Overwrite Then SaveTXTfile filename, txt Else AddIntoTXTfile filename, txt End If End Sub ' =============== Private Function ReadTXTfile(ByVal filename As String) As String Set FSO = CreateObject("scripting.filesystemobject") Set ts = FSO.OpenTextFile(filename, 1, True): ReadTXTfile = ts.ReadAll: ts.Close Set ts = Nothing: Set FSO = Nothing End Function Private Function SaveTXTfile(ByVal filename As String, ByVal txt As String) As Boolean On Error Resume Next: Err.Clear Set FSO = CreateObject("scripting.filesystemobject") Set ts = FSO.CreateTextFile(filename, True) ts.Write txt: ts.Close SaveTXTfile = Err = 0 Set ts = Nothing: Set FSO = Nothing End Function Private Function AddIntoTXTfile(ByVal filename As String, ByVal txt As String) As Boolean On Error Resume Next: Err.Clear Set FSO = CreateObject("scripting.filesystemobject") Set ts = FSO.OpenTextFile(filename, 8, True): ts.Write txt: ts.Close Set ts = Nothing: Set FSO = Nothing AddIntoTXTfile = Err = 0 End Function
|
|||||||
Комментарии
Отправить комментарий