I got bored with opening and closing files whenever I need to write to one, so I wrote a FileWriter class that's used like this:
Public Sub TestWriter()
On Error GoTo ErrHandler
Dim writer As New FileWriter
If writer.OpenFile("c:\test.txt") Then
writer.WriteLine "foo"
End If
ErrHandler:
If Err.Number <> 0 Then
Debug.Print Err.Description
End If
End Sub
If I change the writer.WriteLine "foo" call to writer.WriteLine "foo", "somefile.txt", I'll catch an error and output Invalid filename., as expected. I can also open both c:\test.txt and somefile.txt and then specify either file's filename when calling WriteLine, and write to either file.
I don't need to close anything, but if I want to close an opened file, I can call writer.CloseFile "c:\test.txt" and then I'll get an Invalid filename error if I try to write to it afterwards.
I don't need to explicitly anything, because any file the writer opens gets closed when the writer instance gets terminated / when the object goes out of scope.
Here's the code, I'm particularly interested in the error handling:
'expose raised errors to clients:
Public Enum FileWriterError
InvalidFileName = vbObjectError + 42
End Enum
'manage opened files in a Dictionary:
Private openedFiles As Dictionary
'skip dictionary lookup if only 1 file is opened:
Private quickWriteFile As Long
Option Explicit
The Dictionary being used here is just a toy of mine, reviewable here. There are things I like less with that Dictionary (the fact that its Item getter gives me a KeyValuePair, for instance), but I'd like that to be outside the scope of this review.
Opening a file:
Public Property Get OpenedFilesCount() As Integer
OpenedFilesCount = openedFiles.Count
End Property
Public Function OpenFile(ByVal fileName As String, Optional ByVal overwrite As Boolean = False) As Boolean
Dim fileNumber As Long
fileNumber = GetFileNumber(fileName)
'guard against opening a file that's already opened:
If fileNumber <> FreeFile Then
OpenFile = True
Exit Function
End If
On Error GoTo Catch
If overwrite Or Dir(fileName) = vbNullString Then
Open fileName For Output As #fileNumber
Else
Open fileName For Append As #fileNumber
End If
openedFiles.Add fileName, fileNumber
quickWriteFile = IIf(openedFiles.Count = 1, fileNumber, 0)
Catch:
If Err.number <> 0 Then
Err.Clear
End If
OpenFile = (openedFiles.ContainsKey(fileName))
End Function
Writing a line of text into a file:
Public Sub WriteLine(ByVal data As String, Optional ByVal fileName As String = vbNullString)
Dim fileNumber As Long
Dim result As Boolean
On Error GoTo Catch
If CanWrite(fileName, fileNumber) Then
Print #fileNumber, data
result = True
Else
Err.Raise FileWriterError.InvalidFileName, TypeName(Me) & ".WriteLine", "Invalid filename."
End If
Catch:
If Err.number <> 0 Then
result = False
openedFiles.Remove fileNumber
Err.Raise Err.number, Err.source, Err.description, Err.HelpFile, Err.HelpContext
End If
End Sub
Private Function CanWrite(ByVal fileName As String, ByRef outFileNumber As Long) As Boolean
Dim result As Boolean
Dim fileNumber As Long
Dim proceed As Boolean
If quickWriteFile <> 0 And fileName = vbNullString Then
fileNumber = quickWriteFile
CanWrite = True
Else
CanWrite = openedFiles.TryGetValue(fileName, fileNumber)
End If
outFileNumber = fileNumber
End Function
Closing files:
Public Sub CloseFile(Optional ByVal fileName As String = vbNullString)
If openedFiles.Count = 0 Then Exit Sub
Dim fileNumber As Long
fileNumber = GetFileNumber(fileName)
If fileNumber <> FreeFile Then
Close #fileNumber
openedFiles.Remove fileNumber
If fileNumber = quickWriteFile Then quickWriteFile = 0
End If
If openedFiles.Count = 1 Then quickWriteFile = openedFiles.Values.First
End Sub
Public Sub CloseAllFiles()
Dim file As KeyValuePair
For Each file In openedFiles
Close #file.value
Next
openedFiles.Clear
quickWriteFile = 0
End Sub
Private Function GetFileNumber(ByVal fileName As String) As Long
Dim result As Long
If quickWriteFile <> 0 And fileName = vbNullString Then
result = quickWriteFile
ElseIf Not openedFiles.TryGetValue(fileName, result) Then
result = FreeFile
End If
GetFileNumber = result
End Function
Class initialization and termination:
Private Sub Class_Initialize()
Set openedFiles = New Dictionary
End Sub
Private Sub Class_Terminate()
CloseAllFiles
Set openedFiles = Nothing
End Sub
