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