reading in a .csv file

Hi there,

The following code will parse your .CSV data and return a neat array. Null values are no problem, since the array position will hold no value (len(x) = 0). That is easy to test for, and should pose no problem.

The code to parse a line of .CSV data is the following. It parses the record you put and returns a array with data.

'---------------------------------------------------------------------------------------
' Procedure : ParseCSV
' DateTime  : 29-09-2003 10:35
' Author    : Donald Lessau (VBSpeed.com)
' Purpose   : Parses a CSV input string
' Inputs    : sExpression: string with the CSV text.
'             asValues(): Array with the values.
' Depends   : None
' Revisions :
'
'---------------------------------------------------------------------------------------

Public Function ParseCSV(ByRef sExpression As String, ByRef asValues() As String) As Long
  Const lAscSpace     As Long = 32   ' Asc(" ")
  Const lAscQuote     As Long = 34   ' Asc("""")
  Const lAscSeparator As Long = 44   ' Asc(","), comma
 
  Const lValueNone    As Long = 0 ' states of the parser
  Const lValuePlain   As Long = 1
  Const lValueQuoted  As Long = 2
 
  ' BUFFERREDIM is ideally exactly the number of values in Expression (minus 1)
  ' so: if you know what to expect, fine-tune here
  Const BUFFERREDIM   As Long = 64
  Dim ubValues        As Long
  Dim cntValues       As Long
 
  Dim abExpression() As Byte
  Dim lCharCode As Long
  Dim posStart As Long
  Dim posEnd As Long
  Dim cntTrim As Long
  Dim lState As Long
  Dim i As Long
' ----------------------
  On Error GoTo PROC_ERR

  If LenB(sExpression) > 0 Then
   
    abExpression = sExpression         ' to byte array
    ubValues = -1 + BUFFERREDIM
    ReDim Preserve asValues(ubValues) ' init array (Preserve is faster)
   
    For i = 0 To UBound(abExpression) Step 2
     
      ' 1. unicode char has 16 bits, but 32 bit Longs process faster
      ' 2. add lower and upper byte: ignoring the upper byte can lead to misinterpretations
      lCharCode = abExpression(i) Or (&H100 * abExpression(i + 1))
     
      Select Case lCharCode
     
      Case lAscSpace
        If lState = lValuePlain Then
          ' at non-quoted value: trim 2 unicode bytes for each space
          cntTrim = cntTrim + 2
        End If
     
      Case lAscSeparator
        If lState = lValueNone Then
          ' ends zero-length value
          If cntValues > ubValues Then
            ubValues = ubValues + BUFFERREDIM
            ReDim Preserve asValues(ubValues)
          End If
          asValues(cntValues) = ""
          cntValues = cntValues + 1
          posStart = i + 2
        ElseIf lState = lValuePlain Then
          ' ends non-quoted value
          lState = lValueNone
          posEnd = i - cntTrim
          If cntValues > ubValues Then
            ubValues = ubValues + BUFFERREDIM
            ReDim Preserve asValues(ubValues)
          End If
          asValues(cntValues) = MidB$(sExpression, posStart + 1, posEnd - posStart)
          cntValues = cntValues + 1
          posStart = i + 2
          cntTrim = 0
        End If
     
      Case lAscQuote
        If lState = lValueNone Then
          ' starts quoted value
          lState = lValueQuoted
          ' trims the opening quote
          posStart = i + 2
        ElseIf lState = lValueQuoted Then
          ' ends quoted value, or is a quote within
          lState = lValuePlain
          ' trims the closing quote
          cntTrim = 2
        End If
     
      Case Else
        If lState = lValueNone Then
          ' starts non-quoted value
          lState = lValuePlain
          posStart = i
        End If
        ' reset trimming
        cntTrim = 0
     
      End Select
   
    Next
   
    ' remainder
    posEnd = i - cntTrim
    If cntValues <> ubValues Then
      ReDim Preserve asValues(cntValues)
    End If
    asValues(cntValues) = MidB$(sExpression, posStart + 1, posEnd - posStart)
    ParseCSV = cntValues + 1
  Else
    ' (Expression = "")
    ' return single-element array containing a zero-length string
    ReDim asValues(0)
    ParseCSV = 1
  End If

PROC_ERR:
  Select Case Err.Number
  Case Is <> 0
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure ParseCSV of Module modGeneral"
    Err.Clear
  End Select
End Function

Now, to use the function, this is a piece of code that does the job.

Public Sub cmdRead_Click()
  Dim hFile as long ' File handle
  Dim sRecord as string ' Variable to hold a line from the file.
  Dim asRecord() as string ' Array of strings to hold the record data.
' -----------------------------
  On Error GoTo PROC_ERR

  hFile = FreeFile
  Open "C:\Temp\Input.Csv" For Input As hFile

  ' Read in first record.
  Line Input #hFile, sRecord

  ParseCSV sRecord, asRecord
 
  If (asRecord(0) = "Identity") Then
    ' Header seems ok, read in the rest.
    ' Loop through the file and read in one line then proces that line and
    ' do your stuff to it.
  Else
    MsgBox "Format of input file seems invalid.", vbOkOnly+vbInformation
  End If

PROC_EXIT:
  If (hFile <> 0) Then
    ' Close the file.
    Close hFile
    hFile = 0
  End if

PROC_ERR:
  Select Case Err.Number
  Case Is <> 0
    MsgBox Err.Description, vbOkOnly + vbInformation, Err.Number
    Err.Clear
    Resume PROC_EXIT
  End Select
End Sub

The code sample above is crude and not error proof, so care is advised here. Only to give you a general idea of how to work the magic. The ParseCSV function is about the fastest around, and is error free.

Grtz.&copy;

D.