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. :cheerio:

[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.

:cheers:

[Admin]

Hi,

Thanks for the feedback. :cheers: