VBA - Extracting 3 Text Lines From Text files

[MEGAMETRO]

wow.
I'm really amazed. Mostly due to your generosity on taking the time to work on such a bespoke solution to my issue. Thank you so much.

One thing I just want to query, when the single .txt file contains multiple records all starting with the same header, the code works beautifully. If on 'File Open' I select multiple .txt files, as the information is separated into multiple .txt files (I'm selecting just two for now) , I get a run-time error '13': type mismatch on the line beginning 'Recs(n)...

                    For n = 1 To cnt
                        If n = cnt Then
                            Recs(n) = Mid(Text, Recs(n), Len(Text))

Now. I expect this is a newbie error by myself. (I'm still making my way through VBA for dummies!) If so can you please correct me.

Thank you again,

Luke

[Leith Ross]

Hello Luke,

I assume the format of both files are same. Let me try to reproduce the error.

[MEGAMETRO]

Yes. I just copied the text from the previously attached word docs, and named them 'test1.txt' and 'test2.txt'. Thanks!

[Leith Ross]

Hello Luke,

It is nothing to do with you. Its on me. I out clevered myself. Working on fix.

[Leith Ross]

Hello Luke,

Okay, here is the amended code for the "GetRecords" macro. The attached workbook also has the change.

Change to GetRecords Macro

Sub GetRecords()


    Dim Buffer()    As Byte
    Dim cnt         As Long
    Dim FileSpec    As Variant
    Dim n           As Long
    Dim RecNdx      As Variant
    Dim Recs        As Variant
    Dim Text        As String
    
        ' // Initialize the delimiter and new line variables
        strFS = vbTab
        strNL = vbCrLf
        
        With Application.FileDialog(msoFileDialogOpen)
            .AllowMultiSelect = True
            .Filters.Add "Text Files", "*.csv,*.txt"
            .FilterIndex = .Filters.Count
            
            If .Show = -1 Then
                Application.ScreenUpdating = False
                
                For Each FileSpec In .SelectedItems
                    ' // Read the entire file as a byte aray.
                    Open FileSpec For Binary Access Read As #1
                        ReDim Buffer(LOF(1))
                        Get #1, , Buffer
                    Close #1
        
                    ' // Convert byte array back to a string
                    Text = StrConv(Buffer, vbUnicode)
        
                    ' // Identify each record in the file
                    Do
                        ' // Starting line of each record
                        n = InStr(n + 1, Text, "Time event Notification")
                        If n = 0 Then Exit Do
                        cnt = cnt + 1
                        If IsEmpty(RecNdx) Then
                            ReDim RecNdx(1 To 1)
                        Else
                            ReDim Preserve RecNdx(1 To cnt)
                        End If
                        ' // Save the starting character position of each record
                        RecNdx(cnt) = n
                    Loop
        
                    ReDim Recs(1 To cnt)
                    
                    ' // Extract each record as a srting
                    For n = 1 To cnt
                        If n = cnt Then
                            Recs(n) = Mid(Text, RecNdx(n), Len(Text))
                        Else
                            Recs(n) = Mid(Text, RecNdx(n), RecNdx(n + 1) - RecNdx(n))
                        End If
                    Next n
        
                    Call ParseRecords(Recs)
                Next FileSpec
                
                Application.ScreenUpdating = True
            End If
        End With
        
End Sub

[MEGAMETRO]

Leith! It works perfectly. A dream!
Again, thank you so much!

A very happy man,
Luke

[Leith Ross]

Hello Luke,

Thank you for the chance to create something new from something old. Glad I could help.