CSV.bas

CSV.bas

' Rudimentary CSV parser in VBA. Wheee.
Option Explicit

Public Function IsEmptyRecord(ByRef record() As String)
  IsEmptyRecord = UBound(record) = 0 And record(0) = ""
End Function

' Reads a CSV record from the provided TextStream, assigning the fields
' to the provided array reference. Returns True if a record is read from
' the TextStream, or False if the end of the stream has been reached.
Public Function ReadRecord(ByVal ts As TextStream, ByRef record() As String) As Boolean
  If ts.AtEndOfStream Then
    ReadRecord = False
    Exit Function
  End If
  
  ReDim record(0) As String
  record(0) = Field(ts)
  Do While Not ts.AtEndOfLine And Not ts.AtEndOfStream
    ReDim Preserve record(0 To UBound(record) + 1) As String
    record(UBound(record)) = Field(ts)
  Loop
  ' Discard the end of line sequence
  ts.SkipLine
  ReadRecord = True
End Function

' Reads a field from the provided TextStream, returning the empty string
' if the end of the line or stream has been reached.
Private Function Field(ByVal ts As TextStream) As String
  If ts.AtEndOfStream Or ts.AtEndOfLine Then
    Field = ""
  Else
    Dim c As String
    c = ts.read(1)
    If c = """" Or c = "'" Then
      Field = Quoted(ts, c)
    Else
      Field = Unquoted(ts, c)
    End If
  End If
End Function

' Reads an unquoted field terminated by a comma or the end of the line from the
' provided TextStream.
Private Function Unquoted(ByVal ts As TextStream, ByVal f As String) As String
  Dim c As String
  Unquoted = f
  Do While Not ts.AtEndOfLine
    c = ts.read(1)
    If c = "," Then Exit Function
    Unquoted = Unquoted & c
  Loop
End Function

' Reads a quoted field terminated by the specified quote character from the provided
' TextStream.
Private Function Quoted(ByVal ts As TextStream, ByVal q As String) As String
  Dim c As String
  Quoted = ""
  Do While Not ts.AtEndOfStream
    c = ts.read(1)
    If c = q Then
      ' Handle the case of a quoted field followed by EOL
      If ts.AtEndOfLine Or ts.AtEndOfStream Then Exit Function
      
      c = ts.read(1)
      If c = "," Then
        Exit Function
      ElseIf c = q Then
        Quoted = Quoted & q
      Else
        Err.Raise vbObjectError + 513, _
          "gnwtjustice.CSVReader", _
          "Unexpected end of quoted field, L" & ts.Line & "C" & ts.Column
      End If
    Else
      Quoted = Quoted & c
    End If
  Loop
End Function