Solicito un macro para Guardar un XLS como TXT delimitado por tab sin comillas en ningún campo.
Tengo un par de planitllas en excel que me sirven para migrar datos a mi sistema, pero deben ser en formato de TEXTO delimitado por TABULACIONES, al guardar desde excel, me deja en ocasiones para algunos campos comillas al inicio y final del campo. Lo que hago es abrir el TXT y reemplazar las comillas, con me funciona, pero quisiera que desde una macro me lo guarde ya listo para migrar.
En qué casos te aparecen comillas, es decir, has podido identificar qué dato tienes en la celda y por eso te aparecen las comillas.
Te anexo una macro. Cambia en la macro "Hoja1" por el nombre de la hoja que vas migrar. También cambia "archivo" por el nombre que desees ponerle al archivo destino
Sub Archivo()
'Por.Dante Amor
Const separador As String = vbTab
'
Set h1 = Sheets("Hoja1")
ruta = ThisWorkbook.Path & "\"
If Left(ruta, 1) <> "\" Then ruta = ruta & "\"
nombre = "archivo"
'
fc = h1.UsedRange.SpecialCells(11).Address
f = h1.UsedRange.SpecialCells(11).Row
col = h1.UsedRange.SpecialCells(11).Column
nFileNum = FreeFile
Open ruta & nombre & ".txt" For Output As #nFileNum
For Each r In h1.Range("A1:A" & f).Rows
For Each c In h1.Range(h1.Cells(r.Row, "A"), h1.Cells(r.Row, col))
cadena = cadena & c.Value & separador
Next
Print #nFileNum, cadena
cadena = Empty
Next
Close #nFileNum
MsgBox "Fin"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Gracias Dante esa me funciona casi al 100% solo me podrías indicar como colocar un "IF" para que cuando sea la ultima columna no agregue el "tab" del final, sino que ahí termine la línea.
Te anexo la macro actualizada
Sub Archivo()
'Por.Dante Amor
Const separador As String = vbTab
'
Set h1 = Sheets("Hoja1")
ruta = ThisWorkbook.Path & "\"
If Left(ruta, 1) <> "\" Then ruta = ruta & "\"
nombre = "archivo"
'
fc = h1.UsedRange.SpecialCells(11).Address
f = h1.UsedRange.SpecialCells(11).Row
col = h1.UsedRange.SpecialCells(11).Column
nFileNum = FreeFile
Open ruta & nombre & ".txt" For Output As #nFileNum
For Each r In h1.Range("A1:A" & f).Rows
For Each c In h1.Range(h1.Cells(r.Row, "A"), h1.Cells(r.Row, col))
cadena = cadena & c.Value & separador
Next
If cadena <> "" Then
cadena = Left(cadena, Len(cadena) - 1)
End If
Print #nFileNum, cadena
cadena = Empty
Next
Close #nFileNum
MsgBox "Fin"
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
2 respuestas más de otros expertos
Te adjunto la Macro solicitada
Sub TXTSaver()
Set Tool = Workbooks(ActiveWorkbook.Name)
SavePath = Tool.Path
'setear Hoja a Guardar
Set SaveSH = Sheets("Hoja1")
'Nombre de Archivo
SaveName = "ArchivoTXT " & Format(Date, "dd-mm-yyyy hhmmss") & ".txt"
SaveSH.Copy
NewFileName = SavePath & "\" & SaveName
ActiveWorkbook.SaveAs Filename:=NewFileName, FileFormat:=xlText, CreateBackup:=False
NewWB = ActiveWorkbook.Name
Tool. Activate
Workbooks(NewWB). Close (True)
End SubPor cualquier duda lo vemos.
Por favor recuerda valorar la respuesta!
Slds
Juan
Hola, gracias por la respuesta, sabes que no me funciona la macro, te adjunto el documento con el que lo trabajo para que lo puedas revisar. Muchas gracias por tomarte el tiempo.
https://drive.google.com/drive/folders/0B5p6FheasgcYUk5HSnYyV2d3QjQ?usp=sharing
John, perdón por la demora, te envió una solución definitiva aplicada a tu archivo.
Imprime los valores en un archivo con EncodingUTF8.
https://drive.google.com/a/gointegro.com/file/d/0BzxOiUKo04ZCMndkVHpPVU5pYVU/view?usp=sharing
Slds
Este ejemplo tal vez aporte algo más
¡Gracias! Por tomarte el tiempo, pero videos de youtube no puedo visualizar, tengo bloqueada la página, en todo caso, que bien que te dediques a ayudarnos. Saludos y éxito en todo