Preserving "columns" when writing from a text file to excel using VBA

Assuming that each column is 10 characters long, I would use this width instead of a space delimeter

Sub FeedTextFileToActiveSheet(ByVal TextFile As String)
  Dim i As Integer, Line As String
  Open TextFile For Input As #1
  While Not EOF(#1)
    i = i + 1
    Input #1, Line
    Range("A" & i) = Trim(Mid(Line, 1, 10))  'Business ID
    Range("B" & i) = Trim(Mid(Line, 11, 10)) 'Employee ID
    ' ... and so on
  Wend
  Close #1
End Sub

To use it, just call FeedTextFileToActiveSheet("Path.txt")

Have you tried the "import from text file option" of excel? If you just want to import the text file to excel with or without headers, then you can import directly in excel using the built in option available in excel.This recognises the header and blank spaces properly.One point to be noted is the headers of the text file should always be in first line for this method. If you are not sure of this, then you can go for a vba script.if so, then the link provided by ferdinando will help you.

If you have this file organized visually, I would go by that logic. It means that value of a column starts where the column header starts. This implies that value of a column ends where the next one begins.

Helpful image, describing the logic (also, example text file I used):

All this logic can be done by reading first line, which contains headers, and determining all indexes of beginning of every header. Then, for each line we can easily determine value between two particular indexes, cut it out and trim to remove extra spaces at the beginning and at the end of a value.

Try below code (all necessary comments in code):

Sub ReadDataFromCsv()
    Dim Fn As String, WS As Worksheet, st As String, i As Long, columnHeadersIndexes As Object, numberOfColumns As Long
    Fn = "your path here" ' the file path and name
    Set WS = Sheets("Sheet1")
    ' Create array that will hold indexes of a beginning of a column header
    Set columnHeadersIndexes = CreateObject("System.Collections.ArrayList")
    'Read text file to st string
    With CreateObject("Scripting.FileSystemObject")
        If Not .FileExists(Fn) Then
            MsgBox Fn & "  : is missing."
            Exit Sub
        ElseIf FileLen(Fn) = 0 Then
            MsgBox Fn & "  : is empty"
        Else
            With .OpenTextFile(Fn, 1)
                ' Read first line
                st = .ReadLine
                i = 1
                ' Find beginning of first column name
                Do While Mid(st, i, 1) = " "
                    i = i + 1
                Loop
                columnHeadersIndexes.Add (i)
                ' At least two spaces separate two headers, so we can safely add 2 without risk of loosing any letters frmo next header
                i = i + 2
                Dim j As Long: j = 1
                Do While i < Len(st)
                    ' If we have two spaces followed by non-space, then save index (beginning of a header)
                    If Mid(st, i - 2, 2) = "  " And Mid(st, i, 1) <> " " Then
                        ' Set column header
                        Cells(1, j) = Mid(st, columnHeadersIndexes(columnHeadersIndexes.Count - 1), i - columnHeadersIndexes(columnHeadersIndexes.Count - 1) - 1)
                        columnHeadersIndexes.Add (i)
                        j = j + 1
                    End If
                    i = i + 1
                Loop
                ' Set column header
                Cells(1, j) = Trim(Mid(st, columnHeadersIndexes(columnHeadersIndexes.Count - 1), Len(st)))
                numberOfColumns = columnHeadersIndexes.Count
                ' Skip line with ------ characters
                .ReadLine
                Dim currentRow As Long: currentRow = 2
                Do While .AtEndOfStream <> True
                    st = .ReadLine
                    ' Read all columns from a line
                    For i = 0 To numberOfColumns - 2
                        If Len(st) >= columnHeadersIndexes(i) Then
                            cellValue = Mid(st, columnHeadersIndexes(i), columnHeadersIndexes(i + 1) - columnHeadersIndexes(i) - 1)
                            cellValue = Trim(cellValue)
                            Cells(currentRow, i + 1) = cellValue
                        End If
                    Next
                    ' Read last column, if exists
                    If Len(st) >= columnHeadersIndexes(i) Then
                        'here we pass Len(st) as length for substring - it assures that we don't pass too small value and miss some characters
                        cellValue = Mid(st, columnHeadersIndexes(i), Len(st))
                        cellValue = Trim(cellValue)
                        Cells(currentRow, i + 1) = cellValue
                    End If
                    currentRow = currentRow + 1
                Loop
                .Close
            End With
        End If
    End With
End Sub