Text File Parsing Not Working

[cjscotto]

I have a text file that I am trying to parse into Excel. The file fields are delimited by |. When I use the code below, it parses everything in to the first column. Can anyone help with how to modify the code so that it parses each line of the text file into the appropriate columns and rows?

Dim Delimiter As String
Dim TextFile As Integer
Dim FilePath As String
Dim FileContent As String
Dim LineArray() As String
Dim DataArray() As String
Dim TempArray() As String
Dim rw As Long, col As Long
Dim x As Integer
Dim y As Integer


'Inputs
Delimiter = "|"
FilePath = Application.GetOpenFilename
rw = 0

'Open the text file in a Read State
TextFile = FreeFile
Open FilePath For Input As TextFile

'Store file content inside a variable
FileContent = Input(LOF(TextFile), TextFile)


'Close Text File
Close TextFile

'Separate Out lines of data
LineArray() = Split(FileContent, vbCrLf)


'Read Data into an Array Variable
For x = LBound(LineArray) To UBound(LineArray)
If Len(Trim(LineArray(x))) <> 0 Then
'Split up line of text by delimiter
TempArray = Split(LineArray(x), Delimiter)

'Determine how many columns are needed
col = UBound(TempArray)


'Re-Adjust Array boundaries
ReDim Preserve DataArray(col, rw)

'Load line of data into Array variable
For y = LBound(TempArray) To UBound(TempArray)

DataArray(y, rw) = TempArray
'Debug.Print DataArray(y, rw)

Range("Harp_Anchor").Offset(y, rw) = DataArray(y, rw)

Next y
End If

'Next line
rw = rw + 1

Next x

 

[ParamRay]

Can do it this way:

' Code to import data into Excel
' from pipe-delimited text file.

' Assumes lines are separated by
' carriage return AND line feed.

Public Sub ImportData()
  Dim objFileSystem As Object
  Dim objTextStream As Object
  Dim vntFilePath As Variant
  Dim strFileText As String
  Dim astrData() As String
  Dim y As Integer
  Dim x As Long
    
  On Error GoTo ErrHandler
  vntFilePath = Application.GetOpenFilename("Text Files (*.txt;*.csv), *.txt;*.csv")
  If vntFilePath = False Then GoTo ExitProc
  
  Set objFileSystem = CreateObject("Scripting.FileSystemObject")
  Set objTextStream = objFileSystem.OpenTextFile(vntFilePath, 1)
  strFileText = objTextStream.ReadAll()
  objTextStream.Close
  
  astrData = TextToArray(strFileText, x, y)
  ThisWorkbook.Sheets.Add.Range("A1").Resize(x, y).Value = astrData
  
ExitProc:
  On Error Resume Next
  objTextStream.Close
  Set objTextStream = Nothing
  Set objFileSystem = Nothing
  Exit Sub
  
ErrHandler:
  MsgBox Err.Description, vbExclamation
  Resume ExitProc
End Sub

Private Function TextToArray(ByVal strText As String, _
                             ByRef lngRows As Long, _
                             ByRef intCols As Integer) As String()
  Const strDELIMITER = "|"
  Dim astrRows() As String
  Dim astrCols() As String
  Dim c1 As Integer
  Dim c2 As Integer
  Dim r1 As Long
  Dim r2 As Long
  Dim c As Integer
  Dim r As Long
  
  astrRows = Split(strText, vbCrLf)
  r1 = LBound(astrRows)
  r2 = UBound(astrRows)
  
  astrCols = Split(astrRows(r1), strDELIMITER)
  c1 = LBound(astrCols)
  c2 = UBound(astrCols)
  
  ReDim astrResults(r1 To r2, c1 To c2) As String
  lngRows = r2 - r1 + 1
  intCols = c2 - c1 + 1
  
  For r = r1 To r2
    astrCols = Split(astrRows(r), strDELIMITER)
    For c = c1 To Application.Min(c2, UBound(astrCols))
      astrResults(r, c) = astrCols(c)
    Next c
  Next r
    
  TextToArray = astrResults
End Function