5 de octubre de 2006

Exportar Cursor VFP a EXCEL

Hace un tiempo atrás encontré en este portal una rutina que me fue muy útil, pues exportaba tablas o cursores de VFP a un Libro Excel.

El inconveniente que se me presentó es que cuando utilizaba exportaciones de tablas con demasiados registros, la espera era eterna. Producto que la rutina en cuestión escribía celda a celda los datos de cada registro de la tabla.

Pues bien, buscando siempre mejorar los métodos, les presento esta rutina de exportación de tablas y/o cursores que se apoya en la importación de datos tipo texto de Microsoft Excel:

********************************************************************
********************************************************************
*!* FUNCTION Exp2Excel( [cCursor, [cFileSave, [cTitulo]]] )
*!*
*!* Exporta un Cursor de Visual FoxPro a Excel, utilizando la
*!* técnica de importación de datos externos en modo texto.
*!*
*!* PARAMETROS OPCIONALES:
*!* - cCursor  Alias del cursor que se va a exportar.
*!*            Si no se informa, utiliza el alias
*!*            en que se encuentra.
*!*
*!* - cFileName  Nombre del archivo que se va a grabar.
*!*              Si no se informa, muestra el libro generado
*!*              una vez concluída la exportación.
*!*
*!* - cTitulo  Titulo del informe. Si se informa, este
*!*            ocuparía la primera file de cada hoja del libro.
********************************************************************
********************************************************************
FUNCTION Exp2Excel( cCursor, cFileSave, cTitulo )
  LOCAL cWarning
  cWarning = "Exportar a EXCEL"
  IF EMPTY(cCursor)
    cCursor = ALIAS()
  ENDIF
  IF TYPE('cCursor') # 'C' OR !USED(cCursor)
    MESSAGEBOX("Parámetros Inválidos",16,cWarning)
    RETURN .F.
  ENDIF
  *********************************
  *** Creación del Objeto Excel ***
  *********************************
  WAIT WINDOW 'Abriendo aplicación Excel.' NOWAIT NOCLEAR
  oExcel = CREATEOBJECT("Excel.Application")
  WAIT CLEAR

  IF TYPE('oExcel') # 'O'
    MESSAGEBOX("No se puede procesar el archivo porque no tiene la aplicación" ;
      + CHR(13) + "Microsoft Excel instalada en su computador.",16,cWarning)
    RETURN .F.
  ENDIF

  oExcel.workbooks.ADD

  LOCAL lnRecno, lnPos, lnPag, lnCuantos, lnRowTit, lnRowPos, i, lnHojas, cDefault

  cDefault = ADDBS(SYS(5)  + SYS(2003))

  SELECT (cCursor)
  lnRecno = RECNO(cCursor)
  GO TOP

  *************************************************
  *** Verifica la cantidad de hojas necesarias  ***
  *** en el libro para la cantidad de datos     ***
  *************************************************
  lnHojas = ROUND(RECCOUNT(cCursor)/65000,0)
  DO WHILE oExcel.Sheets.COUNT < lnHojas
    oExcel.Sheets.ADD
  ENDDO

  lnPos = 0
  lnPag = 0

  DO WHILE lnPos < RECCOUNT(cCursor)

    lnPag = lnPag + 1 && Hoja que se está procesando

    WAIT WINDOWS 'Exportando cursor '  + UPPER(cCursor)  + ' a Microsoft Excel...' ;
      + CHR(13) + '(Hoja '  + ALLTRIM(STR(lnPag))  + ' de '  + ALLTRIM(STR(lnHojas)) ;
      + ')' NOCLEAR NOWAIT

    IF FILE(cDefault  + cCursor  + ".txt")
      DELETE FILE (cDefault  + cCursor  + ".txt")
    ENDIF

    COPY  NEXT 65000 TO (cDefault  + cCursor  + ".txt") DELIMITED WITH CHARACTER ";"
    lnPos = RECNO(cCursor)

    oExcel.Sheets(lnPag).SELECT

    XLSheet = oExcel.ActiveSheet
    XLSheet.NAME = cCursor + '_' + ALLTRIM(STR(lnPag))

    lnCuantos = AFIELDS(aCampos,cCursor)

    ********************************************************
    *** Coloca título del informe (si este es informado) ***
    ********************************************************
    IF !EMPTY(cTitulo)
      XLSheet.Cells(1,1).FONT.NAME = "Arial"
      XLSheet.Cells(1,1).FONT.SIZE = 12
      XLSheet.Cells(1,1).FONT.BOLD = .T.
      XLSheet.Cells(1,1).VALUE = cTitulo
      XLSheet.RANGE(XLSheet.Cells(1,1),XLSheet.Cells(1,lnCuantos)).MergeCells = .T.
      XLSheet.RANGE(XLSheet.Cells(1,1),XLSheet.Cells(1,lnCuantos)).Merge
      XLSheet.RANGE(XLSheet.Cells(1,1),XLSheet.Cells(1,lnCuantos)).HorizontalAlignment = 3
      lnRowPos = 3
    ELSE
      lnRowPos = 2
    ENDIF

    lnRowTit = lnRowPos - 1
    **********************************
    *** Coloca títulos de Columnas ***
    **********************************
    FOR i = 1 TO lnCuantos
      lcName  = aCampos(i,1)
      lcCampo = ALLTRIM(cCursor) + '.' + aCampos(i,1)
      XLSheet.Cells(lnRowTit,i).VALUE=lcname
      XLSheet.Cells(lnRowTit,i).FONT.bold = .T.
      XLSheet.Cells(lnRowTit,i).Interior.ColorIndex = 15
      XLSheet.Cells(lnRowTit,i).Interior.PATTERN = 1
      XLSheet.RANGE(XLSheet.Cells(lnRowTit,i),XLSheet.Cells(lnRowTit,i)).BorderAround(7)
    NEXT

    XLSheet.RANGE(XLSheet.Cells(lnRowTit,1),XLSheet.Cells(lnRowTit,lnCuantos)).HorizontalAlignment = 3

    *************************
    *** Cuerpo de la hoja ***
    *************************
    oConnection = XLSheet.QueryTables.ADD("TEXT;"  + cDefault  + cCursor  + ".txt", ;
      XLSheet.RANGE("A"  + ALLTRIM(STR(lnRowPos))))

    WITH oConnection
      .NAME = cCursor
      .FieldNames = .T.
      .RowNumbers = .F.
      .FillAdjacentFormulas = .F.
      .PreserveFormatting = .T.
      .RefreshOnFileOpen = .F.
      .RefreshStyle = 1 && xlInsertDeleteCells
      .SavePassword = .F.
      .SaveData = .T.
      .AdjustColumnWidth = .T.
      .RefreshPeriod = 0
      .TextFilePromptOnRefresh = .F.
      .TextFilePlatform = 850
      .TextFileStartRow = 1
      .TextFileParseType = 1 && xlDelimited
      .TextFileTextQualifier = 1 && xlTextQualifierDoubleQuote
      .TextFileConsecutiveDelimiter = .F.
      .TextFileTabDelimiter = .F.
      .TextFileSemicolonDelimiter = .T.
      .TextFileCommaDelimiter = .F.
      .TextFileSpaceDelimiter = .F.
      .TextFileTrailingMinusNumbers = .T.
      .REFRESH
    ENDWITH

    XLSheet.RANGE(XLSheet.Cells(lnRowTit,1),XLSheet.Cells(XLSheet.ROWS.COUNT,lnCuantos)).FONT.NAME = "Arial"
    XLSheet.RANGE(XLSheet.Cells(lnRowTit,1),XLSheet.Cells(XLSheet.ROWS.COUNT,lnCuantos)).FONT.SIZE = 8

    XLSheet.COLUMNS.AUTOFIT
    XLSheet.Cells(lnRowPos,1).SELECT
    oExcel.ActiveWindow.FreezePanes = .T.

    WAIT CLEAR

  ENDDO

  oExcel.Sheets(1).SELECT
  oExcel.Cells(lnRowPos,1).SELECT

  IF !EMPTY(cFileSave)
    oExcel.DisplayAlerts = .F.
    oExcel.ActiveWorkbook.SAVEAS(cFileSave)
    oExcel.QUIT
  ELSE
    oExcel.VISIBLE = .T.
  ENDIF

  GO lnRecno

  RELEASE oExcel,XLSheet,oConnection

  IF FILE(cDefault + cCursor + ".txt")
    DELETE FILE (cDefault + cCursor + ".txt")
  ENDIF

  RETURN .T.

ENDFUNC

***
***
Saludos desde Chile,

OSCAR CALDERON FUENTES

6 comentarios :

  1. Buen dìa
    Oscar Calderón Fuentes

    Muy buen trabaja muy limpio y fácil de entender y de utilizar Felicidades.

    Me preguntaba si te interesa apoyarme algunos proyectos de programación en VFP ? Tu me informas por medio Skype se me facilita, No podríamos de acuerdo lo que necesito y tu me indicas tiempo y costos ?

    Saludos Cordiales.
    Raúl Orea Tirado.

    Nota: Para utilizar este código que costo tiene o donación a donde lo podría hacer para continua esta aportando a esta comunidad.
    me contactas raul.orea.t@gmail.com o siconeterp@gmail.com

    ResponderEliminar
  2. He utilizado esta rutina, pero si tengo datos con la letra 'Ñ' solo sale un simbolo en su reemplazo. ¿como hago para evitar esto?

    ResponderEliminar
  3. Gracias por el aporte pero no sé cómo utilizarlo.
    Copié el código fuente en un archivo .prg lo llamo con DO NombreProgama|NombreProcedimiento [IN NombrePrograma WITH ListaParametro pero no creó el archivo de exportación a MSO Excel es un error o hay un truco.
    Me gustaría saber cómo exportar directamente los Reportes (REPORT FORM ("Reports\NombreArchivo") TO PRINTER PROMPT SUMMARY
    o REPORT FORM ("Reports\NombreArchivo") PREVIEW
    ) creados en VFP9 a cualquier formatos ("HTML, XML, SHTML, XHTML, DHTML, XSD, XSLT, PDF, XLSX, DOCX" etc.) funcional y explicado de cómo usarlo detalladamente pero sin tantas palabras de adornos (directo, preciso, conciso, locuaz, etc.). Gracias.

    ResponderEliminar
  4. Muchas Gracias es genial!!
    Solo que por cosas de la vida un cursor me dio 91.601 registros y al dividir entre 65.000 solo creo una hoja, pero lo solucione reemplazando esta linea...:
    *************************************************
    *** Verifica la cantidad de hojas necesarias ***
    *** en el libro para la cantidad de datos ***
    *************************************************
    lnHojas = ROUND(RECCOUNT(cCursor)/65000,0)



    *!*.....POR ESTAS ;
    *************************************************
    *** Verifica la cantidad de hojas necesarias ***
    *** en el libro para la cantidad de datos ***
    *************************************************
    lnHojas = (RECCOUNT(cCursor)/65000)
    nDecimal = lnHojas - INT(lnHojas)
    IF nDecimal > 0.0
    lnHojas = INT(lnHojas + 1)
    ENDIF

    ResponderEliminar
  5. Buenos días,estuve observando el código y es perfecto para lo que necesito pero me he dado cuenta que el formato numérico me sale con mas ceros de los que realmente trae el número, por ejemplo en el cursor
    viene 330,500.00 y en el excel este se transforma en 3.305.000.000 me podrías colaborar dándome un guía de como solucionar esto, te lo agradecería mucho, gracias

    ResponderEliminar

Los comentarios son moderados, por lo que pueden demorar varias horas para su publicación.