Genera archivo texto con espacios
A los miembros de este foro, en esta ocasión recurro a Uds, para que me ayuden en como mejor la macro que se describe a continuación, dicho código fue compartido por el amigo Dante Amor, la cual permite Generar de Excel a TXT, la macro funciona perfectamente, el único problema es que al generar el archivo "archivo2afp.txt", muestra campos de más, como se puede apreciar en la imagen 1 y 2 (todo es un solo archivo) y el resultado final debería ser como la imagen 3
Sub GuardarTxtAFP()
'Por.Dante Amor
FileNum = FreeFile()
ruta = ThisWorkbook.Path & "\"
Open ruta & "archivo2afp.txt" For Output As #FileNum
'
lets = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q")
anch = Array(5, 12, 1, 20, 20, 20, 20, 1, 1, 1, 1, 9, 9, 9, 9, 1, 2)
cols = Array("A:Q")
For i = 8 To 134
For j = LBound(cols) To UBound(cols)
Set rango = Columns(cols(j))
For Each col In rango.Columns
dato = Cells(i, col.Column)
If col.Column = Columns("Q").Column Then
dato = Format(Cells(i, col.Column), "dd-mm-yyyy")
End If
micol = col.Column
existe = False
For M = LBound(lets) To UBound(lets)
numcol = Columns(lets(M)).Column
If numcol = micol Then
ancho = anch(M)
existe = True
Exit For
End If
Next
If existe = False Then
ancho = 9
End If
For k = 1 To ancho
car = Mid(dato, k, 1)
If car = "" Then car = " "
Print #FileNum, car;
Next
Next
Next
Print #FileNum,
Next
Close #FileNum
'
MsgBox "Conversión de excel a txt terminada", vbInformation, "CONVERTIR A TXT"
End Sub
Hoja de donde se inicia la conversión:
Imagen 1:
Imagen 2
Imagen 3: Resultado