Import text file to an Excel file

[obed_cruz]

Hi everyone, here asking for your help again.

I have two files, one is an excel file and the other a text file.

I request your help to import the text file to an excel file and the end result is displayed as the worksheet called "CONCENTRATE"

I hope I can help me.

Greetings and Thanks.

[Admin]

Hi,

Try this

Sub kTest()
    
    Dim strTxt  As String
    Dim objFSO  As Object
    Dim arrOP(), Cols
    Dim i       As Long
    Dim n       As Long
    Dim x, Hdr
    Dim Pos1    As Long
    Dim Pos2    As Long
    Dim Pos3    As Long
    Dim Pos4    As Long
    Dim Flg     As Boolean
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    strTxt = objFSO.opentextfile("C:\MyFolder\corp.txt").readall '<<==== adjust the folder
    
    x = Split(strTxt, vbCrLf)
    
    Hdr = Array("TIPO", "NUM", "FECHA", "CUENTA", "CC", "DESCRIPCION CUENTA", "CONCEPTO POLIZA", "CARGO", "ABONO")
    
    Cols = Array(21, 10, 2, 41, 30)
    
    ReDim arrOP(1 To UBound(x), 1 To 9)
    
    For i = 0 To UBound(x)
        If x(i) Like "*Fecha*Concepto*" Then
            n = n + 1
            Pos1 = InStr(1, x(i), "de", 1)
            Pos2 = InStr(1, x(i), "No.", 1)
            Pos3 = InStr(1, x(i), "Concepto", 1)
            
            arrOP(n, 1) = Trim$(Mid$(x(i), Pos1 + 3, 3))
            arrOP(n, 2) = Trim$(Mid$(x(i), Pos2 + 3, 8))
            arrOP(n, 3) = CDate(Trim$(Mid$(x(i), Pos3 - 12, 10)))
            arrOP(n, 7) = Trim$(Mid$(x(i), Pos3 + 10))
            Pos4 = n
            Flg = True
            GoTo Nxt
        ElseIf Flg Then
            arrOP(n, 1) = arrOP(Pos4, 1)
            arrOP(n, 2) = arrOP(Pos4, 2)
            arrOP(n, 3) = arrOP(Pos4, 3)
            arrOP(n, 7) = arrOP(Pos4, 7)
            
            arrOP(n, 4) = Trim$(Mid$(x(i), Cols(0), Cols(1)))
            arrOP(n, 5) = Trim$(Mid$(x(i), Cols(0) + Cols(1), Cols(2) + 2))
            arrOP(n, 6) = Trim$(Mid$(x(i), Cols(0) + Cols(1) + Cols(2) + 2, Cols(3)))
            arrOP(n, 9) = Trim$(Mid$(x(i), Cols(0) + Cols(1) + Cols(2) + Cols(3) + Cols(4) + 17, 15))
            If Len(arrOP(n, 9)) Then
                arrOP(n, 8) = Trim$(Mid$(x(i), Cols(0) + Cols(1) + Cols(2) + Cols(3) + Cols(4) + 2, 15))
                Flg = False
            Else
                arrOP(n, 8) = Trim$(Mid$(x(i), Cols(0) + Cols(1) + Cols(2) + Cols(3) + Cols(4) - 7, 15))
            End If
            n = n + 1
        End If
Nxt:
    Next
    If n Then
        [a1].Resize(, 9) = Hdr
        [a2].Resize(n - 1, 9).Value = arrOP
    End If
End Sub

[obed_cruz]

Thanks Admin

The code works fine, but I have the following problem when importing.
Sometimes in column I ("ABONO") in the text file are more than one record, now the importing is only the first row of column I and I need that when there are more records were imported also.

Please could you help me with this?.

annex the text file where the problem occurs and also annex the Excel file highlighting in yellow the way it should be.

I appreciate your valuable time and help.

[Admin]

Hi,

Thanks for the feedback. Try this one.

Option Explicit

Sub kTest()
    
    Dim strTxt  As String
    Dim objFSO  As Object
    Dim arrOP(), Cols
    Dim i       As Long
    Dim n       As Long
    Dim x, Hdr
    Dim Pos1    As Long
    Dim Pos2    As Long
    Dim Pos3    As Long
    Dim Pos4    As Long
    
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    
    strTxt = objFSO.opentextfile("C:\Users\Kannan\Downloads\corp.txt").readall '<<==== adjust the folder
    
    x = Split(strTxt, vbCrLf)
    
    Hdr = Array("TIPO", "NUM", "FECHA", "CUENTA", "CC", "DESCRIPCION CUENTA", "CONCEPTO POLIZA", "CARGO", "ABONO")
    
    Cols = Array(21, 10, 2, 41, 30)
    
    ReDim arrOP(1 To UBound(x), 1 To 9)
    
    For i = 0 To UBound(x)
        If x(i) Like "*Fecha*Concepto*" Then
            n = n + 1
            Pos1 = InStr(1, x(i), "de", 1)
            Pos2 = InStr(1, x(i), "No.", 1)
            Pos3 = InStr(1, x(i), "Concepto", 1)
            
            arrOP(n, 1) = Trim$(Mid$(x(i), Pos1 + 3, 3))
            arrOP(n, 2) = Trim$(Mid$(x(i), Pos2 + 3, 8))
            arrOP(n, 3) = CDate(Trim$(Mid$(x(i), Pos3 - 12, 10)))
            arrOP(n, 7) = Trim$(Mid$(x(i), Pos3 + 10))
            Pos4 = n
        ElseIf x(i) Like "*###-##-##*" Then
            arrOP(n, 1) = arrOP(Pos4, 1)
            arrOP(n, 2) = arrOP(Pos4, 2)
            arrOP(n, 3) = arrOP(Pos4, 3)
            arrOP(n, 7) = arrOP(Pos4, 7)
            
            arrOP(n, 4) = Trim$(Mid$(x(i), Cols(0), Cols(1)))
            arrOP(n, 5) = Trim$(Mid$(x(i), Cols(0) + Cols(1), Cols(2) + 2))
            arrOP(n, 6) = Trim$(Mid$(x(i), Cols(0) + Cols(1) + Cols(2) + 2, Cols(3)))
            arrOP(n, 9) = Trim$(Mid$(x(i), Cols(0) + Cols(1) + Cols(2) + Cols(3) + Cols(4) + 17, 15))
            If Len(arrOP(n, 9)) Then
                arrOP(n, 8) = Trim$(Mid$(x(i), Cols(0) + Cols(1) + Cols(2) + Cols(3) + Cols(4) + 2, 15))
            Else
                arrOP(n, 8) = Trim$(Mid$(x(i), Cols(0) + Cols(1) + Cols(2) + Cols(3) + Cols(4) - 7, 15))
            End If
            n = n + 1
        End If
    Next
    If n Then
        [a1].Resize(, 9) = Hdr
        [a2].Resize(n - 1, 9).Value = arrOP
    End If
End Sub

[obed_cruz]

Thanks,
Works great.

You saved me hours of work, it's great to have forums like this and people like you.

[Admin]

Hi,

Thanks for the feedback.