Home > Back-end >  VBA Read Text file to worksheet
VBA Read Text file to worksheet

Time:07-03

I have a Text file which looks like this

'52132205501000655                                                                                                                                                                                                                                                                       
JAMES BOND                                                                                                                                                                                                                                                                        
CC34TYU               ,'006039869                               ,    350000, -358300.51,         0,19-04-2022,     8300.51,          0,001A                                                                                                                                               
1 DAY < ACCOUNT OVERDRAWN <= 90 DAYS  

'0362205501000655                                                                                                                                                                                                                                                                       
WILSON JOE                                                                                                                                                                                                                                                                        
CC34ZYU               ,'006039869                               ,    550000, -358300.51,         0,19-04-2022,     8300.51,          0,001A                                                                                                                                               
1 DAY < ACCOUNT OVERDRAWN <= 60DAYS 

'0552205501000955                                                                                                                                                                                                                                                                       
QUEEN VELVET                                                                                                                                                                                                                                                                        
CDDFTYU               ,'006039869                               ,    350000, -358300.51,         0,19-04-2022,     8300.51,          0,001A                                                                                                                                               
1 DAY < ACCOUNT OVERDRAWN <= 50DAYS  

I want output in a spreadsheet like MS Excel like this

'52132205501000655 JAMES BOND CC34TYU '006039869 350000 -358300.51 0 19-04-2022 8300.51 1 DAY < ACCOUNT OVERDRAWN <= 90 DAYS 

which is to say that until my program encounters a blank line it should read all the values and if it contains a delimiter(, in my case) split them and put them in consecutive rows. My code reads as

Sub ReadTextFileWithSeparators()
  Dim StrLine As String
  Dim FSO As New FileSystemObject
  Dim TSO As Object
  Dim StrLineElements As Variant
  Dim RowIndex As Long
  Dim ColIndex As Long
  Dim Delimiter As String
  Set FSO = CreateObject("Scripting.FileSystemObject")
  Set TSO = FSO.OpenTextFile("C:\temp\sample.txt")
  Delimiter = ","
  RowIndex = 1
  
  Do While TSO.AtEndOfStream = False
  StrLine = TSO.ReadLine
  
   Do While StrLine <> vbNullString
            StrLine = TSO.ReadLine
            StrLineElements = Split(StrLine, Delimiter)
            For ColIndex = LBound(StrLineElements) To UBound(StrLineElements)
            Cells(RowIndex, ColIndex   1).Value = StrLineElements(ColIndex)
            Next ColIndex
   Loop
    RowIndex = RowIndex   1
  Loop
  TSO.Close
  Set TSO = Nothing
  Set FSO = Nothing
End Sub

However i dont seem to get the desired output. Where i am doing wrong

CodePudding user response:

Please, test the next code. It uses arrays and should be very fast, processing only in memory. It assumes that all text file contains groups of four lines, separate by an empty line. It will return in separate cells for each file line. The processing result will be dropped in the active sheet, starting from "A1" (header included):

Sub ReadTextFile()
   Dim textFileName As String, arrTxt, arrRet, arr4Lines, arrL, arrFin, colNo As Long
   Dim i As Long, j As Long, L As Long, k As Long, kk As Long, n As Long, sep As String
   
   textFileName = "C:\temp\sample.txt"
   sep = vbCrLf 'ito be changed with vbCr or vbLf if the text file will not be split on the chosen line separator
   
   arrTxt = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(textFileName, 1).ReadAll, sep)
   
   If UBound(arrTxt) = 0 Then MsgBox "Strange line separator..." & vbCrLf & _
                                     "Try replacing it with 'vbCr' or 'vbLf 'and run the code again.", vbInformation, _
                                     "Separator change needed": Exit Sub
   
   colNo = UBound(Split(arrTxt(2), ","))   4 'the number of necessary columns in the final array (in a consistent txt file)
   ReDim arrFin(1 To UBound(arrTxt)   5, 1 To colNo): kk = 1 'the final array to drop its content in the sheet
   
   For i = 0 To UBound(arrTxt) Step 5
        ReDim arr4Lines(UBound(Split(arrTxt(2), ",")) * 4) 'to be sure that it is enough space to place all split elements...
        For j = 0 To 3
            If left(arrTxt(i   j), 1) = "=" Or arrTxt(i   j) = "" Then Exit For 'for the ending file part
            arrL = Split(arrTxt(i   j), ",")
            For L = 0 To UBound(arrL)
                arr4Lines(k) = WorksheetFunction.Trim(arrL(L)): k = k   1 'place in the array all the line elements (separated by comma)
            Next L
        Next j
        If k > 0 Then
            ReDim Preserve arr4Lines(k - 1)      'keep only the loaded array elements
            For n = 0 To k - 1
                arrFin(kk, n   1) = arr4Lines(n) 'place the elements in the final array
            Next n
            kk = kk   1                          'increment the final array row
        End If
        Erase arr4Lines: k = 0
   Next i
   
   'drop the processed array content at once and format a little the respective range:
   With ActiveSheet.Range("A2").Resize(kk - 1, colNo)
        .value = arrFin
        .rows(1).Offset(-1) = Array("Column1", "Column2", "Column3", "Column4", "Column5", "Column6", _
                                         "Column7", "Column8", "Column9", "Column10", "Column11", "Column12") 'place here the necessary headers
        .EntireColumn.AutoFit
   End With
End Sub
  • Related