FoxPro/Visual FoxPro - Pasar de DBF a XLS

* Generar un cursor para pasar a Microsoft Excel por Automatización

SELECT nombre,idclien,cuit,calle,numero,ciudad,provincia ;

	FROM clientes ;

	WHERE !EMPTY(idclien) ;

	ORDER BY nombre ;

	INTO CURSOR curClien READWRITE

Export_Excel("curClien")

PROCEDURE export_excel

*---------------------

LPARAMETERS tcCursor

LOCAL loExcel as Object,;

	loSheet as Object,;

	loBook as Object,;

	lnItem,;

	lnRow,;

	lnCol,;

	lnFields,;

	lcField,;

	lcType,;

	lxValor,;

	lxDefault,;

	lnPasos,;

	loExCreate as Exception,;

	loExGen as Exception

lnRow = 0

lnCol = 0

lnPasos = 0

lnFields = AFIELDS(laFields,m.tcCursor)

TRY

	loExcel = NEWOBJECT("Excel.Application")

CATCH TO loexCreate

	loExCreate.UserValue = PROGRAM()

	MESSAGEBOX("No tiene la aplicación Microsoft Excel ® instalada")

FINALLY

ENDTRY

IF VARTYPE(loExCreate) # "O"

	TRY

		loBook = loExcel.workbooks.ADD()

		loSheet = loExcel.ActiveSheet

		SELECT (m.tcCursor)

		SCAN

			lnRow = m.lnRow + 1

			lnCol = 0

			FOR lnItem = 1 TO m.lnfields

				lxValor = EVALUATE(FIELD(m.lnItem,m.tcCursor))

				lcType = VARTYPE(m.lxValor)

				lxDefault = ICASE(m.lcType="N",0,;

							m.lcType="C","",;

							m.lcType="L",".f.",;

							m.lcType="D",null,;

							m.lctype="T",null,;

							"")

				IF m.lcType = "L"

					lxValor = TRANSFORM(m.lxValor)

				ELSE

					IF EMPTY(m.lxvalor)

						lxValor = m.lxDefault

					ENDIF

				ENDIF

				lnCol = m.lnCol + 1

				loSheet.Cells(m.lnRow,m.lnCol).Value = m.lxValor

			ENDFOR

			lnPasos = m.lnPasos + 1

			IF lnPasos > 99

				WAIT WINDOW TRANSFORM(m.lnRow)+" Registros Transferidos..." AT 15,20 NOWAIT

				lnPasos = 0

			ENDIF

		ENDSCAN

		loSheet.COLUMNS.AUTOFIT

	CATCH TO loexGen

		loExGen.UserValue = PROGRAM()

		ShowError(loexGen)

	FINALLY

		WAIT CLEAR

		loExcel.Visible = .t.

		loSheet = null

		loBook = null

		loExcel = null

		USE IN SELECT(m.tcCursor)

	ENDTRY

ENDIF

ENDPROC

resp=MESSAGEBOX("¿Despues de convertir la tabla, el sistema se cerrará" + chr(13);

+ "para evitar conflictos de incompatibilidad." + chr(13)+;

chr(13)+ ;

 "                 ¿Desea continuar?                  ",4+32+0,"Personal Municipal")

IF resp=6 &&si

	gcTableName = GETFILE('DBF', 'Nombre de archivo:')

	IF EMPTY(gcTableName)  && Esc presionada

		RETURN

	ENDIF

	USE (gcTableName)

	gcDelimName = ALIAS( ) + '.XLS'

	gcDelimFile = PUTFILE('Nombre de archivo:', gcDelimName, 'XLS')

	IF EMPTY(gcDelimFile)  && Esc presionada

		RETURN

	ENDIF

	Wait Windows "Convirtiendo tabla a hoja de cálculo." + CHR(13) +;

	"Espere uno segundos por favor..." NOWAIT

	COPY TO (gcDelimFile) TYPE XL5

	Wait Windows "Proceso completado" TIMEOUT 3

	*CLOSE ALL

	CLEAR ALL

	*QUIT

	ELSE

ENDIF