[RESUELTO] Macro para exportar datos a archivo .txt

BrunoF · Mensaje por **BrunoF** » Vie Jul 25, 2014 2:03 pm

Buenas amigos de la comunidad! Espero que esten bien. Les planteo un problema para ver si pueden darme una mano, ya que soy nuevo en la programación ooBasic, apoyandome en el libro de Mauricio.

Les cuento: tenemos una aplicación muy vieja la cual toma un archivo de excel y lo transforma a un .txt, la cual no funciona con archivos .ods y obviamente no hay soporte para la reprogramación de la aplicación, por lo cual corresponde hacer una macro que sustituya dicha aplicación.

El txt generado tiene los siguientes requsitos:

Largo de caracteres necesario en cada columna

Columna A (3)
Columna B (1)
Columna C (5)
Columna D (8)
Columna E (10)
Columna F (10)
Columna G (1)
Columna H (15)
Columna I (10)
Columna J (8)
Columna K (28)
Columna L(2)

El largo total de las columnas debe ser de 101 digitos.
Ejemplo: Si en la columna H que es de 15 digitos, ponemos solo 5, en el txt deben estar los 5 y completar los restantes 11 con espacios en blanco.

Hasta ahora tengo el siguiente código el cual exporta las columnas a un archivo txt, pero no he podido dar con el tema de los largos, solo toma el dato que esta en la celda y lo pasa.

Código: Seleccionar todo

Sub ExportarATxt

  '----------------------------------------------------------------------
  ' Guardar documento

  Dim documento As Object
  Dim dispatcher As Object
  documento = ThisComponent.CurrentController.Frame
  dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
  dispatcher.executeDispatch(documento, ".uno:Save", "", 0, Array())

  '----------------------------------------------------------------------
  ' Exportar a archivo de texto

  Dim oDoc As Object ' El documento actual
  Dim oHojas As Object ' La colección de hojas del documento
  Dim oHoja As Object ' Hoja en específico
  Dim oHojaDefault As Object ' Hoja para definir donde quedará
  Dim sNewFilename As String ' Nuevo nombre de texto
  Dim sExt As String ' La nueva extensión a aplicar
  Dim sURL As String ' URL existente en el documento
  Dim sCurrDir As String ' Directorio actual
  Dim FileProperties(2) As New com.sun.star.beans.PropertyValue

  oDoc = thisComponent
  oHojas = oDoc.Sheets()
  oHoja = oHojas.getByName("Temp")
  oHojaDefault = oHojas.getByName("Resumen")
  sURL = ConvertFromURL(oDoc.getLocation())
  sCurrDir = Mid(sURL,1,Len(sURL)-Len(Dir(sURL)))
  
  FileProperties(0).Name = "Overwrite"
  FileProperties(0).Value = True
  FileProperties(1).Name = "FilterName"
  FileProperties(1).Value = "Text - txt - csv (StarCalc)"
  FileProperties(2).Name = "FilterOptions"
  'FileProperties(2).Value = "9,0,ANSI,1"
  'FileProperties(2).Value = "FIX,,0,1,0/2/10/36/19/4"
  FileProperties(2).Value = "FIX,,2,5,3/2/10/36/19/4"
  'Separación,Inicio de fila,
  sExt = ".txt"

    sNewFilename = "Archivo" & sExt
    oDoc.CurrentController.setActiveSheet(oHoja)
    oDoc.storeToURL(ConvertToURL(sCurrDir & sNewFilename),FileProperties())

  oDoc.CurrentController.setActiveSheet(oHojaDefault) ' Seteamos la hoja a mostrar

  MsgBox("¡Archivo .txt creado con éxito!")

End Sub

Espero me puedan dar una mano. Desde ya les agradezco. Un gran abrazo desde Uruguay!

Mensaje por **PepeOooSevilla** » Mar Jul 29, 2014 10:37 am

Hola.
Te damos la bienvenida al foro y, por favor, no dejes de leer la Guía de supervivencia.

Una de las posibles soluciones a tu consulta la tienes en el archivo adjunto.
Este es el código fuente:

Código: Seleccionar todo

Option Explicit

Sub Exportar_A_TXT_v2
	Dim oDoc As Object ' El documento actual
	Dim oHojas As Object ' La colección de hojas del documento
	Dim oHoja As Object ' Hoja en específico
	Dim sNewFilename As String ' Nuevo nombre de texto
	Dim sURL As String ' URL existente en el documento
	Dim sCurrDir As String ' Directorio actual
	Dim sExt As String ' La nueva extensión a aplicar
	Dim NumeroArchivo As Integer
	Dim LongitudColumnas(0) As Integer ' Columnas A-L. Columna A = índice 0 del array
	Dim DatoCelda As String
	Dim FilaActual As Long
	Dim Contador As Long
	Dim UltimaColumna As Long
	Dim LineaResultado As String
	
	Const COLUMNA_A As Long = 0
	
	UltimaColumna = 11	' Columna_L
	ReDim LongitudColumnas(UltimaColumna)
							' COLUMNAS	LONGITUD
	LongitudColumnas(0) = 3		' Columna_A		3
	LongitudColumnas(1) = 1		' Columna_B		1
	LongitudColumnas(2) = 5		' Columna_C		5
	LongitudColumnas(3) = 8		' Columna_D		8
	LongitudColumnas(4) = 10          ' Columna_E		10
	LongitudColumnas(5) = 10	        ' Columna_F		10
	LongitudColumnas(6) = 1		' Columna_G		1
	LongitudColumnas(7) = 15	        ' Columna_H		15
	LongitudColumnas(8) = 10	        ' Columna_I		10
	LongitudColumnas(9) = 8		' Columna_J		8
	LongitudColumnas(10) = 28	' Columna_K		28
	LongitudColumnas(11) = 2	        ' Columna_L		2
							' TOTAL			101

	oDoc = ThisComponent
	oHojas = oDoc.Sheets()
	oHoja = oHojas.getByName("DATOS")
	sURL = ConvertFromURL(oDoc.getLocation())
	sCurrDir = Mid(sURL, 1, Len(sURL)-Len(Dir(sURL)))
	sExt = ".txt"
	sNewFilename = sCurrDir & "Archivo_" & Format(Now, "yyyymmddhhmmss") & sExt
	' ¡Atención! Los datos comienzan en la Fila 3 (El índice de la Fila 1 es 0)
	FilaActual = 2
	' ¡Atención! Los datos comienzan en la Columna A (El índice de la Columna A es 0)	
	NumeroArchivo = FreeFile
	Open sNewFilename For Output As #NumeroArchivo
	With oHoja
		Do While .getCellByPosition(COLUMNA_A, FilaActual).getString() <> "Fin listado"
			LineaResultado = ""
			For Contador = 0 To UltimaColumna
				DatoCelda = .getCellByPosition(Contador, FilaActual).getString()
				If Len(DatoCelda) < LongitudColumnas(Contador) Then
					DatoCelda = DatoCelda & Space(LongitudColumnas(Contador) - Len(DatoCelda))
				End If
				LineaResultado = LineaResultado & DatoCelda
			Next
			Print #NumeroArchivo, LineaResultado
			FilaActual = FilaActual + 1
		Loop
	End With
	Close NumeroArchivo
End Sub

Recuerda añadir el texto "Fin listado" para que la macro termine.
Para que CALC no interprete los textos numéricos como números es conveniente que el formato de todas las celdas con datos sean tipo "Texto" (Formato->Celdas...->Pestaña Números->Texto), porque si no, interpretará "12345678910111213" como 1,23456789101112E+016 y, obviamente, no interesa.
Al nombre del archivo TXT resultante le he añadido la fecha y hora del sistema en el momento de la creación en formato AAAAMMDDHHMMSS (año mes día hora minuto segundo).
Deberías modificar la macro para controlar los posibles errores que se puedan dar.

Si consideras que el tema está resuelto, indícalo (¿Cómo marcar como RESUELTO un tema?), ya que, de esta forma, conseguiremos un foro más ordenado.
Saludos cordiales.

BrunoF · Mensaje por **BrunoF** » Sab Ago 02, 2014 2:04 am

Que fácil lo hacen! Y yo que estaba así

jaja. Buenísima la macro, ya lo había resuelto a lo picapiedras utilizando funciones de Calc, ahí armaba el formato y luego lo exportaba. Está macro va de lujo con algunos ajustes a mis necesidades. En cuanto pueda la estudio bien. Pepe te agradezco muchísimo, gran trabajo. Un abrazo desde Uruguay!

cesp · Mensaje por **cesp** » Mar Jul 07, 2015 5:20 pm

Buenos Dias.

Estoy viendo sus macros y me parecen muy interesantes, la verdad yo no se mucho de eso pero necesito una macro igual que me respete la longuitud, que si en la columna pongo 5 letras y es de 10 me ponga las otras 5 en blanco, espero y me puedan ayudar con eso.

Pongo la segunda formula en la macron y no me deja; no se si este mal o yo este haciendo algo mal.

Estare en espera de alguna respuesta.

Saludos.

Mensaje por **SLV-es** » Mié Jul 08, 2015 12:45 pm

La macro desarrollada aquí es para exportar a un documento de texto en formato "ancho de campo fijo".
Puedes grabar una macro mientras exportas a un documento en formato CSV (en realidad, guardar como > CSV) que genera un documento de texto separado por puntos y comas, de ancho variable.

Obtendrás algo similar a esto:

Código: Seleccionar todo

sub ExportarCSV
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(2) as new com.sun.star.beans.PropertyValue
args1(0).Name = "URL"
args1(0).Value = "file:///K:/Mis%20Documentos/prueba%20macro.csv"
args1(1).Name = "FilterName"
args1(1).Value = "Text - txt - csv (StarCalc)"
args1(2).Name = "FilterOptions"
args1(2).Value = "59,34,ANSI,1,,0,true,true,true"

dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())

end sub

Ahora, con un poco de imaginación, haces este cambio y ya tienes una macro más usable

Código: Seleccionar todo

sub ExportarCSV( cRutaNombreDestino as string)
rem ----------------------------------------------------------------------
rem define variables
dim document   as object
dim dispatcher as object
rem ----------------------------------------------------------------------
rem get access to the document
document   = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")

rem ----------------------------------------------------------------------
dim args1(2) as new com.sun.star.beans.PropertyValue
args1(0).Name = "URL"
args1(0).Value = ConvertToURL(cRutaNombreDestino )
args1(1).Name = "FilterName"
args1(1).Value = "Text - txt - csv (StarCalc)"
args1(2).Name = "FilterOptions"
args1(2).Value = "59,34,ANSI,1,,0,true,true,true"

dispatcher.executeDispatch(document, ".uno:SaveAs", "", 0, args1())

end sub

Taveg · Mensaje por **Taveg** » Jue Jul 07, 2016 8:14 pm

Buenas tardes,

Agradezco el conocimiento compartido. me interesa como funciona la macro pero no me es posible hacerla ejecutar. me muestra un error de Compilación. donde dice que la matriz ya tiene dimenciones. no se como pueda ejecutar la macro agradezco la ayuda que me puedan dar

Mensaje por **mauricio** » Jue Jul 07, 2016 8:54 pm

¿Exactamente en que línea te muestra el error?... por otra parte, si tus datos tienen otra estructura, es mucho mejor que abras un nuevo tema.

Saludos

Taveg · Mensaje por **Taveg** » Jue Ago 25, 2016 5:35 pm

Buenos Días,

Qué pena con la insistencia, estoy retomando el tema y la verdad creo que el código que se creó para este tema me es de utilidad, y quiera solicitar de su colaboración, no tengo mucho conocimiento sobre las macros pero se lo fabuloso que pueden llegar a ser.

Solo necesito poder ejecutarla, pero me sale;

Error de compilación:
La Matriz ya tiene dimensiones.

En la línea

ReDim LongitudColumnas(UltimaColumna)

Agradezco un montón su ayuda.

fgili · Mensaje por **fgili** » Mié Ene 10, 2018 9:15 pm

PepeOooSevilla escribió:Hola.
Te damos la bienvenida al foro y, por favor, no dejes de leer la Guía de supervivencia.

Una de las posibles soluciones a tu consulta la tienes en el archivo adjunto.
Este es el código fuente:
Código: Seleccionar todo
Option Explicit

Sub Exportar_A_TXT_v2
	Dim oDoc As Object ' El documento actual
	Dim oHojas As Object ' La colección de hojas del documento
	Dim oHoja As Object ' Hoja en específico
	Dim sNewFilename As String ' Nuevo nombre de texto
	Dim sURL As String ' URL existente en el documento
	Dim sCurrDir As String ' Directorio actual
	Dim sExt As String ' La nueva extensión a aplicar
	Dim NumeroArchivo As Integer
	Dim LongitudColumnas(0) As Integer ' Columnas A-L. Columna A = índice 0 del array
	Dim DatoCelda As String
	Dim FilaActual As Long
	Dim Contador As Long
	Dim UltimaColumna As Long
	Dim LineaResultado As String
	
	Const COLUMNA_A As Long = 0
	
	UltimaColumna = 11	' Columna_L
	ReDim LongitudColumnas(UltimaColumna)
							' COLUMNAS	LONGITUD
	LongitudColumnas(0) = 3		' Columna_A		3
	LongitudColumnas(1) = 1		' Columna_B		1
	LongitudColumnas(2) = 5		' Columna_C		5
	LongitudColumnas(3) = 8		' Columna_D		8
	LongitudColumnas(4) = 10          ' Columna_E		10
	LongitudColumnas(5) = 10	        ' Columna_F		10
	LongitudColumnas(6) = 1		' Columna_G		1
	LongitudColumnas(7) = 15	        ' Columna_H		15
	LongitudColumnas(8) = 10	        ' Columna_I		10
	LongitudColumnas(9) = 8		' Columna_J		8
	LongitudColumnas(10) = 28	' Columna_K		28
	LongitudColumnas(11) = 2	        ' Columna_L		2
							' TOTAL			101

	oDoc = ThisComponent
	oHojas = oDoc.Sheets()
	oHoja = oHojas.getByName("DATOS")
	sURL = ConvertFromURL(oDoc.getLocation())
	sCurrDir = Mid(sURL, 1, Len(sURL)-Len(Dir(sURL)))
	sExt = ".txt"
	sNewFilename = sCurrDir & "Archivo_" & Format(Now, "yyyymmddhhmmss") & sExt
	' ¡Atención! Los datos comienzan en la Fila 3 (El índice de la Fila 1 es 0)
	FilaActual = 2
	' ¡Atención! Los datos comienzan en la Columna A (El índice de la Columna A es 0)	
	NumeroArchivo = FreeFile
	Open sNewFilename For Output As #NumeroArchivo
	With oHoja
		Do While .getCellByPosition(COLUMNA_A, FilaActual).getString() <> "Fin listado"
			LineaResultado = ""
			For Contador = 0 To UltimaColumna
				DatoCelda = .getCellByPosition(Contador, FilaActual).getString()
				If Len(DatoCelda) < LongitudColumnas(Contador) Then
					DatoCelda = DatoCelda & Space(LongitudColumnas(Contador) - Len(DatoCelda))
				End If
				LineaResultado = LineaResultado & DatoCelda
			Next
			Print #NumeroArchivo, LineaResultado
			FilaActual = FilaActual + 1
		Loop
	End With
	Close NumeroArchivo
End Sub
Recuerda añadir el texto "Fin listado" para que la macro termine.
Para que CALC no interprete los textos numéricos como números es conveniente que el formato de todas las celdas con datos sean tipo "Texto" (Formato->Celdas...->Pestaña Números->Texto), porque si no, interpretará "12345678910111213" como 1,23456789101112E+016 y, obviamente, no interesa.
Al nombre del archivo TXT resultante le he añadido la fecha y hora del sistema en el momento de la creación en formato AAAAMMDDHHMMSS (año mes día hora minuto segundo).
Deberías modificar la macro para controlar los posibles errores que se puedan dar.

Si consideras que el tema está resuelto, indícalo (¿Cómo marcar como RESUELTO un tema?), ya que, de esta forma, conseguiremos un foro más ordenado.
Saludos cordiales.

HOla, he utilizado el archivo adjunto en este post con la macro y funciona ok pero me piden un archivo de texto con las siguientes caracteristicas:
Son 5 lineas y cada linea tene unos campos determinados y algunos en blanco (y hay que respetar las posiciones)
Adjunto imagen para que se entienda mejor el formato
Imagen

Las lineas siguientes tienen otras caracteristicas de espacios diferentes
Es posible hacerlo?
alguien puede decirme como?

Adjunto ejemplo de txt que me enviaron como modelo de como quedaria con los datos ingresados

Muchas gracias!!

Mensaje por **PepeOooSevilla** » Vie Ene 12, 2018 8:44 am

Hola.
Lee la respuesta de este tema

Exportar a TXT

Saludos cordiales.

fgili · Mensaje por **fgili** » Vie Ene 12, 2018 9:36 am

Hola Gracias por responder ya estoy mareado con este tema no se como hacero
adjunto el archivo

[RESUELTO] Macro para exportar datos a archivo .txt

[RESUELTO] Macro para exportar datos a archivo .txt

Re: Macro para exportar datos a archivo .txt

Re: Macro para exportar datos a archivo .txt

Re: [RESUELTO] Macro para exportar datos a archivo .txt

Re: [RESUELTO] Macro para exportar datos a archivo .txt

Re: [RESUELTO] Macro para exportar datos a archivo .txt

Re: [RESUELTO] Macro para exportar datos a archivo .txt

Re: [RESUELTO] Macro para exportar datos a archivo .txt

Re: Macro para exportar datos a archivo .txt

Re: [RESUELTO] Macro para exportar datos a archivo .txt

Re: [RESUELTO] Macro para exportar datos a archivo .txt