Macro para convertir archivo xlsx a txt

Los miembros de este foro, en esta ocasión quisiera pedir su valiosa colaboración en una macro que permita convertir el archivo adjunto en xlsx a formato TXT, cuyas columnas como a utilizar serian:
B, C, F,
L hasta AA,
AC hasta AI,
AL hasta AM y
AO hasta AQ,
Y seria a partir de la fila B8 hasta la fila B134 (en esta ultima fila quisiera que permita modificar ya que a veces se puede llegar a utilizar mas filas.

1 respuesta

Respuesta
1

H o l a:

¿Puedes decirme qué tipo de txt?

¿Cómo se va a llamar el archivo txt?

De qué forma guardar tú el archivo, si pudieras activar la grabadora de macros y realizar el guardado a txt de tu archivo xls, y me envías la macro que se genera, para ver cómo quieres el archivo.

H o l a:

Te anexo la macro, el nombre del archivo txt: "archivo2.txt"

Sub ConvertirTxt()
'Por.Dante Amor
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Set l1 = ThisWorkbook
    Set h1 = Sheets("Hoja1")
    Set l2 = Workbooks.Add
    Set h2 = l2.Sheets(1)
    'l2.Activate
    ruta = l1.Path & "\"
    cols = Array("B", "C", "F", "L:AA", "AC:AI", "AL:AM", "AO:AQ")
    j = 1
    'u = h1.UsedRange.Rows(h1.UsedRange.Rows.Count).Row
    For i = LBound(cols) To UBound(cols)
        Set rango = Columns(cols(i))
        For Each col In rango.Columns
            h1.Columns(col.Column).Copy
            h2.Columns(j).PasteSpecial xlValues
            j = j + 1
        Next
    Next
    h2.Rows(1 & ":" & 7).Delete
    l2.SaveAs Filename:=ruta & "archivo2.txt", FileFormat:=xlTextMSDOS
    l2.Close False
    MsgBox "Conversión de excel a txt terminada", vbInformation, "CONVERTIR A TXT"
End Sub

Buenos días amigo Dante Amor, el aporte esta excelente y era lo que anda buscando, solo hay un pequeño error al generar el archivo2.txt, la fila B135 hacia abajo ya no debe figurar y lo otro si se puede uniformar los campos como el espacio de:

DNI, espacio OK

APELLIDOS Y NOMBRES, espacio de 40 caracteres

FECHA DE NACIMIENTO, salio un código distinto que debería ser 00-00-0000

y entre el resto de columnas un espacio de 8 dígitos.

Crees amigo Dante hacer esa modificación y por lo anterior todo esta OK. 

Gracias nuevamente por tus múltiples aportes, eres un Maestro. 

H o l a:

No sé en cuáles columnas está la información que comentas.

Para establecer un ancho de columna se tiene que hacer con otra macro.

Tienes que modificar en la nueva macro las columnas que tienen un ancho diferente a 8.

Yo puse en la macro en estas líneas, que la columna "C" es de 40 y que la columna "F" es de 10.

lets = Array("C", "F")
Anch = Array(40, 10)

Entonces, en la macro tienes que corregir esas columnas y poner las letras y las longitudes. Solamente tienes que poner las que su longitud es diferente de 8.


Para el formato de la fecha, yo estoy suponiendo que la columna con la fecha es la "F", entonces en la siguiente línea de la macro tienes que cambiar la letra "F" por la letra de la columna que tiene la fecha:

If col.Column = Columns("F").Column Then


La nueva macro:

Sub GuardarTxt()
'Por.Dante Amor
    FileNum = FreeFile()
    ruta = ThisWorkbook.Path & "\"
    Open ruta & "archivo2.txt" For Output As #FileNum
    '
    lets = Array("C", "F")
    anch = Array(40, 10)
    cols = Array("B", "C", "F", "L:AA", "AC:AI", "AL:AM", "AO:AQ")
    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("F").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 = 8
                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

S a l u d o s . D a n t e   A m o r. Recuerda valorar la respuesta. G r a c i a s

¡Gracias! 

Desde ya agradezco nuevamente amigo Dante, por los múltiples aportes que brindas en este foro y si la macro quedo excelente.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas