Visual Basic for Applications/从 VBA 使用日志文件
有时从 VBA 向文本文件写入字符串很有用。例如，列出文件、它们的哈希值，或者只是记录错误。这里的文本文件指的是带有.txt后缀的文件。代码模块中列出了用于写入和读取此类文件的几个过程。
- SendToLogFile 过程将字符串追加到文本文件中。用户可以选择自己的路径和文件名，但此方法没有覆盖选项。如果用户未提供参数，则使用默认值。此过程将参数字符串与时间日期字符串放在同一行，每个记录条目都位于新行。
- LogError1 过程旨在追加日志错误，并作为Print# 语句的示例。这里假设日志文件始终放置在调用工作簿所在的同一个文件夹中。因此，不需要路径检查，只需最少的编码。所有参数文本的格式都假定在外部完成。读者可以在 VBA 帮助中找到Print# 的格式详细信息，也可以考虑比较使用Write# 语句的优势。
- LogError2 过程也旨在追加日志错误，并执行与LogError1 相同的任务。然而，它是Scripting 对象的OpenTextFile 方法的示例。此过程需要 VBA 编辑器中的Microsoft Scripting Runtime 的引用。请注意，此日志将把每个连续记录写入第一行，除非参数字符串本身末尾包含vbNewLine 字符。
- WriteToFile 过程会替换任何现有的文本，而不是将其追加到任何现有条目。
- 日志记录有一些约定。使用文本文件（.txt）进行日志记录意味着将每个记录放在同一行上，单个字段用单个制表符分隔。每个记录的字段数相同。另一种约定是使用逗号分隔文件格式 (.csv)，其中字段用逗号而不是制表符分隔。这两种格式都可以导入到 MS Office 应用程序中，但用户应特别注意不同的日志写入方法如何处理引号。
- VBA 还可以读取 文本文件到代码中进行处理。但是，一旦引入了读取 文件的概念，写入格式的选择就变得更加重要。此外，文件读取可能会对错误处理和测试路径完整性提出更高的要求。
- GetAllFileText 过程返回.txt 文件的全部内容。读者应首先确认文本文件存在。此系列中其他地方的文件实用程序适合此目的。
- GetLineText 过程返回一个包含文本文件行的数组。有关早期文件检查的相同注释也适用于这种情况。
Option Explicit
Sub TestSendToLogFile()
'Run this to test the making of a log entry
Dim sTest As String
'make a test string
sTest = "Test String"
'calling procedure - path parameter is optional
SendToLogFile sTest
End Sub
Function SendToLogFile(ByVal sIn As String, Optional sLogFilePath As String = "") As Boolean
'APPENDS the parameter string and a date-time string to next line of a log file
'You cannot overwrite this file; only append or read.
'If path parameter not given for file, or does not exist, defaults are used.
'Needs a VBA editor reference to Microsoft Scripting Runtime
Dim fs, f, strDateTime As String, sFN As String
'Make a date-time string
strDateTime = Format(Now, "dddd, mmm d yyyy") & " - " & Format(Now, "hh:mm:ss AMPM")
'select a default file name
sFN = "User Log File.txt"
'Create a scripting object
Set fs = CreateObject("Scripting.FileSystemObject")
'if path not given then get a default path instead
If sLogFilePath = "" Then
sLogFilePath = ThisWorkbook.Path & "\" & sFN
Else
'some path was provided - so continue
End If
'Open file for appending text at end(8)and make if needed(1)
On Error GoTo ERR_HANDLER
'set second arg to 8 for append, and 1 for read.
Set f = fs.OpenTextFile(sLogFilePath, 8, 1)
Err.Clear
'write to file
f.Write sIn & vbTab & strDateTime & vbCrLf
'close file
f.Close
SendToLogFile = True
Exit Function
ERR_HANDLER:
If Err.Number = 76 Then 'path not found
'make default path for output
sLogFilePath = ThisWorkbook.Path & "\" & sFN
'Open file for appending text at end(8)and make if needed(1)
Set f = fs.OpenTextFile(sLogFilePath, 8, 1)
'resume writing to file
Resume Next
Else:
If Err.Number <> 0 Then
MsgBox "Procedure SendToLogFile has a problem : " & vbCrLf & _
"Error number : " & Err.Number & vbCrLf & _
"Error Description : " & Err.Description
End If
Exit Function
End If
End Function
Function LogError1(sIn As String) As Boolean
'APPENDS parameter string to a text file
'assumes same path as calling Excel workbook
'makes file if does not exist
'no layout or formatting - assumes external
Dim sPath As String, Number As Integer
Number = FreeFile 'Get a file number
sPath = ThisWorkbook.Path & "\error_log1.txt" 'modify path\name here
Open sPath For Append As #Number
Print #Number, sIn
Close #Number
LogError1 = True
End Function
Function WriteToFile(sIn As String, sPath As String) As Boolean
'REPLACES all content of text file with parameter string
'makes file if does not exist
'no layout or formatting - assumes external
Dim Number As Integer
Number = FreeFile 'Get a file number
'write string to file
Open sPath For Output As #Number
Print #Number, sIn
Close #Number
WriteToFile = True
End Function
Function LogError2(sIn As String) As Boolean
'Scripting Method - APPENDS parameter string to a text file
'Needs VBA editor reference to Microsoft Scripting Runtime
'assumes same path as calling Excel workbook
'makes file if does not exist
'no layout or formatting - assumes external
Dim fs, f, sFP As String
'get path for log
sFP = ThisWorkbook.Path & "\error_log2.txt"
'set scripting object
Set fs = CreateObject("Scripting.FileSystemObject")
'make and open file
'for appending text (8)
'make file if not exists (1)
Set f = fs.OpenTextFile(sFP, 8, 1)
'write record to file
'needs vbNewLine charas added to sIn
f.Write sIn '& vbNewLine
'close file
f.Close
LogError2 = True
End Function
Sub TestGetAllFileText()
'run this to fetch text file contents
Dim sPath As String, sRet As String, vRet As Variant
sPath = "C:\Users\Your Folder\Documents\test.txt"
'check that file exists - see file utilities page
'If FileFound(sPath) Then
If GetAllFileText(sPath, sRet) = True Then
MsgBox sRet
End If
'Else
'MsgBox "File not found"
'End If
End Sub
Function GetAllFileText(sPath As String, sRet As String) As Boolean
'returns all text file content in sRet
'makes use of Input method
Dim Number As Integer
'get next file number
Number = FreeFile
'Open file
Open sPath For Input As Number
'get entire file content
sRet = Input(LOF(Number), Number)
'Close File
Close Number
'transfers
GetAllFileText = True
End Function
Sub TestGetLineText()
'run this to fetch text file contents
Dim sPath As String, sRet As String, vRet As Variant
Dim n As Long
sPath = "C:\Users\Internet Use\Documents\test.txt"
'check that file exists - see file utilities page
'If FileFound(sPath) Then
'print text files lines from array
If GetLineText(sPath, vRet) = True Then
For n = LBound(vRet) To UBound(vRet)
Debug.Print vRet(n)
Next n
End If
'Else
'MsgBox "File not found"
'End If
End Sub
Function GetLineText(sPath As String, vR As Variant) As Boolean
'returns all text file lines in array vR
'makes use of Input method
Dim Number As Integer, sStr As String
Dim vW As Variant, sF As String, n As Long
'redim array
ReDim vW(0 To 1)
'get next file number
Number = FreeFile
'Open file
Open sPath For Input As #Number
'loop though file lines
Do While Not EOF(Number)
n = n + 1
Line Input #Number, sStr
ReDim Preserve vW(1 To n)
vW(n) = sStr
'Debug.Print sStr
Loop
'Close File
Close #Number
'transfers
vR = vW
GetLineText = True
End Function