Get data out of a CSV file

Question

There are many hits on google about this but i'm wondering what is the best/fastest way to get some data out of a CSV file? There are some that load the entire CSV file in excel, some load it in an array. I've seen some people like to do search for a specific word.

Basically I need to retrieve 4 values out of each present CSV file. (start/end time, equipment and substrate) Note that the equipment will repeat itself multiple times inside every file. The other 3 are unique.

Which method is best/fastest?

Here's a small example of the CSV file:

/port_name   A
#data 01
  @slot_no        2
  @m_start 2020/03/26 19:15:27
  @m_end   2020/03/26 19:23:21
  @u_start  ????/??/?? ??:??:??
  @u_end    ????/??/?? ??:??:??
  $result 1 1 -4,-4 2548
    <result_info>    1 : Kind                 : 
    &no_of_image 3
    &i_name 01 S02.tif
     ~i_info    Digital_Zoom            1.0
     ~i_info    Equipment               4000 SERIAL NO. : 31
    &i_name 02 S02.tif
     ~i_info    Digital_Zoom            1.0
     ~i_info    Equipment               4000 SERIAL NO. : 31
~CMS_substrate_id      2 "8939-02"
/end_of_file

Answer 1

A quick start of a macro might look like this:

Sub readCSVfile()
    Dim textline As String
    Dim Filename
    Filename = "D:\TEMP\excel\61039635\CSVfile.txt"
    Dim row As Integer

    Cells(1, 1).Value = "m_start"
    Cells(1, 2).Value = "m_end"
    Cells(1, 3).Value = "Equipment"
    Cells(1, 4).Value = "CMS_substrate_id"
    row = 2
    Open Filename For Input As #1
    Do While Not EOF(1)
        Line Input #1, textline
        Select Case True
            Case InStr(textline, "@m_start") > 0:
                Cells(row, 1).Value = mysub(textline, "@m_start")
            Case InStr(textline, "@m_end") > 0:
                Cells(row, 2).Value = mysub(textline, "@m_end")
            Case InStr(textline, "Equipment") > 0:
                Cells(row, 3).Value = mysub(textline, "Equipment")
            Case InStr(textline, "CMS_substrate_id") > 0:
                Cells(row, 4).Value = mysub(textline, "CMS_substrate_id")
                row = row + 1
        End Select

    Loop

    Close (1)

End Sub
Function mysub(t As String, s As String) As String
    mysub = Trim(Mid(t, InStr(t, s) + Len(s) + 1))
End Function

Answer 2

My answer is similar to @Luuk, but I'm not checking for "Equipment" as it appears in the sample data twice per record. Instead, I am checking for "&i_name 01" and then skipping down a few lines.

Sub sGetData()
    On Error GoTo E_Handle
    Dim strFile As String
    Dim intFile As Integer
    Dim strInput As String
    Dim lngRow As Long
    strFile = "J:\downloads\sample.txt"
    intFile = FreeFile
    Open strFile For Input As intFile
    lngRow = 1
    Do
        Line Input #intFile, strInput
        If InStr(strInput, "@m_start") > 0 Then
            lngRow = lngRow + 1
            ActiveSheet.Cells(lngRow, 1) = Mid(strInput, 12)
        ElseIf InStr(strInput, "@m_end") > 0 Then
            ActiveSheet.Cells(lngRow, 2) = Mid(strInput, 12)
        ElseIf InStr(strInput, "&i_name 01") > 0 Then
            Line Input #intFile, strInput
            Line Input #intFile, strInput
            ActiveSheet.Cells(lngRow, 3) = Mid(strInput, 41, 4)
        ElseIf InStr(strInput, "~CMS_substrate_id") > 0 Then
            ActiveSheet.Cells(lngRow, 4) = Mid(strInput, 24)
        End If
    Loop Until EOF(intFile)
sExit:
    On Error Resume Next
    Reset
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sGetData", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

As this data file is probably not line terminated with the normal Carriage Return/Line Feed combination that VBA deals with, I've created a new sub that reads the data into an array, split on the end of line character being used (in this case Line Feed) before processing it.

Sub sGetData2()
    On Error GoTo E_Handle
    Dim strFile As String
    Dim intFile As Integer
    Dim strInput As String
    Dim astrData() As String
    Dim lngLoop1 As Long
    Dim lngCount As Long
    Dim lngRow As Long
    strFile = "J:\downloads\sample1.txt"
    intFile = FreeFile
    Open strFile For Input As intFile
    strInput = input(LOF(intFile), intFile)
    astrData() = Split(strInput, vbLf)
    lngCount = UBound(astrData)
    lngRow = 1
    For lngLoop1 = 3 To lngCount
        If InStr(astrData(lngLoop1), "@m_start") > 0 Then
            lngRow = lngRow + 1
            ActiveSheet.Cells(lngRow, 1) = Mid(astrData(lngLoop1), 12)
        ElseIf InStr(astrData(lngLoop1), "@m_end") > 0 Then
            ActiveSheet.Cells(lngRow, 2) = Mid(astrData(lngLoop1), 12)
        ElseIf InStr(astrData(lngLoop1), "&i_name 01") > 0 Then
            lngLoop1 = lngLoop1 + 2
            ActiveSheet.Cells(lngRow, 3) = Mid(astrData(lngLoop1), 41, 4)
        ElseIf InStr(astrData(lngLoop1), "~CMS_substrate_id") > 0 Then
            ActiveSheet.Cells(lngRow, 4) = Mid(astrData(lngLoop1), 24)
        End If
    Next lngLoop1
sExit:
    On Error Resume Next
    Reset
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sGetData2", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

Regards,

Answer 3

1. Get String from your text file by adodb.stream object.
2. Extract what you are looking for from the imported string with regexp.
3. Put the second contents of the submatches of the extracted match collection into an array. Equipment items have two identical contents, so they are increased by two.
4. The data in the array is transferred to the sheet.

---

Sub Test()
    Dim Ws As Worksheet
    Dim Path As String
    Dim s As String
    Dim pattn(1 To 4) As String
    'Dim Match(1 To 4) As MatchCollection
    Dim Match(1 To 4) As Object
    Dim vR() As Variant
    Dim i As Long, n As Long, j As Integer, k As Long

    Path = ThisWorkbook.Path & "\regextest.txt" '<~~ Your text file full Path

    s = getString(Path) '<~~ get text form your text file

    Set Ws = ActiveSheet

    '** This is regular Expression
    pattn(1) = "(m_start[ ]{1,})(\d{4}/\d{2}/\d{2} \d{2}:\d{2}:\d{2})"
    pattn(2) = "(m_end[ ]{1,})(\d{4}/\d{2}/\d{2} \d{2}:\d{2}:\d{2})"
    pattn(3) = "(~i_info    Equipment[ ]{1,})(\d{1,})"
    pattn(4) = "(~CMS_substrate_id[ ]{1,})(\d{1,}[ ]{1,}" & Chr(34) & "\d{1,}-\d{1,}" & Chr(34) & ")"

    For i = 1 To 4
        Set Match(i) = GetRegEx(s, pattn(i))
    Next i

    n = Match(1).Count
    ReDim vR(1 To n, 1 To 4)

    For i = 0 To n - 1
        For j = 1 To 4
            If j = 3 Then
                vR(i + 1, j) = Match(j).Item(k).SubMatches(1)
                k = k + 2
            Else
                vR(i + 1, j) = Match(j).Item(i).SubMatches(1)
            End If
        Next j
    Next i
    With Ws
        .Cells.Clear
        .Range("a1").Resize(1, 4) = Array("m_start", "m_end", "Equipment", "CMS_substrate_id")
        .Range("a2").Resize(n, 4) = vR
        .Range("a:b").NumberFormatLocal = "yyyy/mm/dd hh:mm:ss"
    End With
End Sub

Function GetRegEx(StrInput As String, strPattern As String) As Object
    'Dim RegEx As New RegExp
    Dim RegEx As Object

    'Set RegEx = New RegExp
    Set RegEx = CreateObject("VBscript.RegExp")
    With RegEx
        .Global = True
        .IgnoreCase = False
        .MultiLine = True
        .Pattern = strPattern
    End With
    If RegEx.Test(StrInput) Then
        Set GetRegEx = RegEx.Execute(StrInput)
    End If
End Function

Function getString(Path As String)
    'Dim objStream As ADODB.Stream
    Dim objStream As Object

    'Set objStream = New ADODB.Stream
    Set objStream = CreateObject("ADODB.Stream")

    With objStream
        .Charset = "Utf-8"
        .Open
        .LoadFromFile Path
        getString = .ReadText
        .Close
    End With

End Function

Result image (3 types of data)