Macro para exportar excel a txt con longitud de columna fijo
Recientemente tome una de las macros de por aquí y la adpate a mis necesidades, solo que no encuentro la forma de establecer la cantidad de caracteres por columna, es decir, que rellene los caracteres faltantes en cada columna con espacios vacíos en el txt.
Ejemplo:
Columna A 3 caracteres
Columna B 10 caracteres
Al escribir en excel en las celdas A2 "548" y en B2 "5469723" y al momento de exportarlo a txt por medio de la macro escriba en el txt la información de la celda "B2" (5469723 ) completando con espacios hasta completar los 10 caracteres.
Muchas gracias y saludos cordiales!
Esta es la macro:
Sub exporta()
ruta = ActiveWorkbook.Path & "\"
Open ruta & "exporta.txt" For Output As #1
Sheets("DATOS").Select
Range("a3").Select
Do While ActiveCell.Offset(0, 1).Value <> ""
ubica = ActiveCell.Address
Do While ActiveCell.Column < 8
If ActiveCell.Value <> "" Then
lista = lista & "|" & ActiveCell.Value
End If
ActiveCell.Offset(0, 1).Select
Loop
lista = Mid(lista, 2, Len(lista) - 1)
Print #1, lista
lista = ""
Range(ubica).Offset(1, 0).Select
Loop
Close #1
MsgBox "El TXT fue guardado en la ruta: " & ruta
End Sub
2 Respuestas
Te regreso la macro ordenada.
Genera el correo y pega las celdas al final del correo.
No me dijiste exactamente en dónde quieres pegar las celdas.
Con esta instrucción se va al final del correo
SendKeys "^{END}"
Cambia esa instrucción por
SendKeys "{Down}"
Para el número de líneas que quieras recorrer hacia abajo.
Por ejemplo, para pegar las celdas en la quinta línea.
Sub Mail_Outlook_With_Signature_Html_1()
'Por.Dante Amor
For i = 2 To 2 'Range("B" & Rows.Count).End(xlUp).Row
Set dam = CreateObject("Outlook.Application").CreateItem(0)
strbody = "<H2><B>Estimado(a).</B></H2>"
strbody1 = "<H3><B>Con la finalidad de que puedan programar los pagos y evitar contratiempos, envió los recibos de pago a vencer, favor de hacer los pagos antes de la fecha de vencimiento para evitar quedar desprotegidos.</B></H3>"
FechLim = "<H3><B>Fecha Limite:________Asegurado_______Auto________Aseguradora________Poliza IMPORTE </B></H3>"
strbody2 = "<H3><B>Si ya fue realizado favor de hacer caso omiso y favor de mandar una copia del pago para cualquier aclaración.</B></H3>" & _
"Cualquier duda quedo a tus ordenes.<br>" & _
"<A HREF=""[email protected]"">[email protected]</A>" & _
"<br><br><B>Favor de Confirmar la Recepcion</B>"
With dam
.To = Range("B" & i) 'Destinatarios
.CC = Range("C" & i) 'Con copia
.BCC = Range("D" & i) 'Con copia oculta
.Subject = Range("E" & i) '"Asunto"
.HTMLBody = strbody & Range("M" & i) & strbody1 & FechLim & Range("F" & i) & "<br>" & " RAMO " & Dato1 & " ASEGURADORA " & Range("O" & i) & "POLIZA " & Range("P" & i) & " IMPORTE " & Range("Q" & i) & "<br>" & strbody2
Range("N" & i, "Q" & i).Copy
.display
SendKeys "{Down}"
SendKeys "{Down}"
SendKeys "{Down}"
SendKeys "{Down}"
SendKeys "^v"
DoEvents
.display
For j = Range("H1").Column To Range("L1").Column
If Cells(i, j).Value <> "" Then .Attachments.Add Cells(i, j).Value
Next
.display
End With
Next
MsgBox "Correos enviados", vbInformation, "SALUDOS"
End SubSaludos.Dante Amor
No olvides valorar la respuesta.
Perdona, por equivocación puse esta macro en tu pregunta.
Retomando tu pregunta, al final de cada columna hay que poner esto:
"|"
¿Y quieres que todas las columnas tengan un ancho fijo?
Veo que la macro lee 7 columnas, me puedes decir el ancho para cada columna.
Muchas gracias Dante, es correcto, la macro lee 7 columnas y al finalizar cada columna agrega un pipe "|", el ancho de las columnas seria el siguiente:
A=4 | B=7 | C=3 | D=10 | E=8 | F=19 | G=1 |
ejemplo:
1533|523791 |240|2015-23-01|87523648|1501515.55 |X
Muchas gracias y saludos de antemano.
Abel Abrego
Ahora sí, te anexo la macro para poner las columnas con una longitud fija.
Sub ExportarExcelTxt()
'Por.Dante Amor
FileNum = FreeFile()
ruta = ThisWorkbook.Path & "\"
Open ruta & "exporta.txt" For Output As #FileNum
Sheets("DATOS").Select
'
cols = Array(0, 4, 7, 3, 10, 8, 19, 1)
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To 7
dato = Cells(i, j)
For k = 1 To cols(j)
car = Mid(dato, k, 1)
If car = "" Then car = " "
Print #FileNum, car;
Next
Print #FileNum, "|";
Next
Print #FileNum,
Next
Close #FileNum
'
MsgBox "El TXT fue guardado en la ruta: " & ruta
End SubSaludos.Dante Amor
No olvides valorar la respuesta.
Hola, perdón por consulta, solo una pregunta sencilla, cómo podría hacer para sacar los pipes de esta macro? Me interesa usarla pero los pipes no me son de utilidad - Victor Fretes