How To Parse A Flat File In Excel VBA

In another post I demonstrated how to access a file on your computer using the MS Office Library. Here it is if you don’t know what I’m talking about.

In this post, I am going to show you how to access the file and load it into your spreadsheet. I will do the same thing in another post, but load an access table and query it.

Below I will have a video which shows you how to do it but here is the code:

Access the File

…First I click the drawing object on the workshee, launch a macro, and show the user that there is something going on:

Sub Rectangle1_Click()
    
    Application.Cursor = xlWait
    ImportRPT
    
    MsgBox "complete"
End Sub

This bit of code gets the file name:

Public Function GetFile(start_here, title_bar As String) As String

    Dim intChoice As Integer
    Dim strPath As String

    'needs reference to the MS office object library
    'only allow the user to select one file

    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .InitialFileName = start_here
        .Title = title_bar
    End With

    'make the file dialog visible to the user

    intChoice = Application.FileDialog(msoFileDialogOpen).Show

    'determine what choice the user made

    If intChoice <> 0 Then
        'get the file path selected by the user
        strPath = Application.FileDialog(msoFileDialogOpen).SelectedItems(1)
        'MsgBox strPath
        GetFile = strPath
    End If

End Function

This bit of code loads the selected file in a memory array so we can parse it. We are also clearing the cells instead of deleting them. Deleting them will mess up the formula on the “Visual” sheet.

Private Sub ImportRPT()
       
    Dim strFileName As String, strRawLine As String, strLine As String
    Dim intRow As Integer, intCol As Integer
    
    Dim varContents As Variant
    
    
    On Error GoTo errhandler
    
    Sheets("data").Range("A1:GG5000").Clear 'delete with mess up the aggregation sheet

    strFileName = GetFile(strStart, "Select Your Import File")
    
    Open strFileName For Input As #1
    intRow = 1
    Do While Not EOF(1)             ' Loop until end of file.
        Line Input #1, strRawLine   ' Read line into variable.

        
        'how many delimiters are there? (if there is a space and then a space, its consecutive)
        strLine = ConsecutiveDelims(strRawLine, Chr(32))  'Chr(32) = space
        varContents = Split(strLine, Chr(32)) 'split everything on spaces no matter what
        
        'Stop
        Debug.Print strLine
        For intCol = 1 To UBound(varContents)
            Sheets("data").Cells(intRow, intCol) = varContents(intCol - 1)
        Next intCol
        
        intRow = intRow + 1
        
        Application.StatusBar = "Please Wait, Processing Row: " & intRow & "..." 'let the user know something is happening and they aren't waiting for nothing
    Loop
    
    Close #1
    
    Application.Cursor = xlDefault 'reset the cursor
    Application.StatusBar = "Ready" 'Set the status bar back to normal
Exit Sub

errhandler:

    MsgBox Err.Number & " - " & Err.Description, vbInformation, APP_NAME

    Application.Cursor = xlDefault
    
    
End Sub

Since our flat file is delimited by spaces, some lines have more consecutive spaces than others, so this special function “treats consecutive delimiters as one”.

Also we are notifying the user that something is going on, when we are using the “Application.StatusBar” command.

    
    'Purpose: to remove the consecutive delimiters and return a text value containing only 1 delimiter
    'if the same delimiter appears twice, it is a candidate
    
    'loop passed text
    Dim strWorkText As String, strNextChar As String, strResult As String
    Dim intPointer As Integer, intCounter As Integer
    
    intCounter = 0
    strWorkText = TextIn
    
    For intPointer = 1 To Len(strWorkText)
        strNextChar = Mid(strWorkText, intPointer, 1)
        Debug.Print strNextChar
        If InStr(1, strNextChar, Delim) Then
            intCounter = intCounter + 1

            If intCounter <= 1 Then
                strResult = strResult & strNextChar
            End If
        Else
            strResult = strResult & strNextChar
            intCounter = 0 'reset the counter

        End If
        
    Next
    
    ConsecutiveDelims = strResult
End Function

Write the file to a Worksheet

In another worksheet the data is aggregated

Let me know if you have any questions.

Thanks

By the way, if you got or are getting value from the VBA information, please give me a tip, thanks!