Importar a Excel archivos en Visual FoxPro

Ante todo le doy las gracias.
Tengo archivos en visual foxpro las cuales son dbf's
Las cuales necesito importarlos a excel.
Pregunta si me pudiera dar donde puedo obtener un programa que me realice estas importaciones.
Gracias.

1 respuesta

Respuesta
1
Lo he usado con vfp7 en adelante, de todas formas te voy a enviar un código para que lo pruebes en Vfp6 y me avisas-
Espero poder colaborarte
Pon la Función rep_excel en las librería y lo llamas así:
select CAMPOS from ARCHIVOS where CONDICIONES into cursor RTA
rep_excel("RTA","NOMBRE1"."NOMBRE2"."NOMBRE3")
Mira el resultado y determina que es cada parámetro, el primero si es el nombre del cursor de la consulta
*********************************************************************************************************
FUNCTION rep_excel(lcursor AS STRING, lnombre AS STRING, lDescripcion AS STRING, LDescripcion1 AS String)
*********************************************************************************************************
  *!*       Parametros:
  *!*      lcursor: Nombre del Cursor o Tabla que se va a llevar a excel
  *!*      lnombre: El titulo de la pagina
  *!*
  ************************************
  *!* Program:Rep_excel
  *!* Author: José G. Samper
  *!* Date: 10/09/03 04:08:04 PM
  *!* Copyright: NetBuzo's
  *!* Description: Esta función lleva a una hoja excel el contenido de un cursor
  *! * Colocando un Nombre pasado como parámetro y los nombres de los campos del cursor como encabezado
  *!* Revision Information:1.0
  *!* Ejemplo de Uso: =rep_excel('mitabla','Listado de Artículos con sus Precios')
  *!* Enviar Bugs o sugerencias para mejoras a j_samper(sin)@cantv.net
  *************************************
LOCAL R, lcampo, lpag, lReg AS INTEGER &&&&variable para determinar la página a ingresar los datos por si hay más de 60 mil registros
    IF TYPE('lcursor')#'C' OR !USED(lcursor)
        =MESSAGEBOX("Parametros Invalidos",16,'De VFP a Excel')
        RETURN .F.
    ENDIF
    IF TYPE('lnombre')#'C'
        lnombre=''
    ENDIF
    lpag=1
    *** Creación del Objeto Excel
    WAIT WINDOW 'Abriendo aplicación Excel.' NOWAIT
    Oexcel = CREATEOBJECT("Excel.Application")
    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,'De VFP a Excel')
        RETURN .F.
    ENDIF
    WAIT WINDOWS 'Procesando Tabla...'+LOWER(lcursor) nowait
    XLApp = Oexcel
    XLApp.workbooks.ADD()
    XLSheet = XLApp.ActiveSheet
    XLSheet.NAME = lnombre + "_" + ALLTR(STR(lpag))
    SELECT(lcursor)
    lcuantos=AFIELDS(lcampos,lcursor)
    lReg = ReCcount()
    GO TOP IN (lcursor)
    R=6
    SCAN
        WAIT WINDOWS STR(RECNO()*100/lReg,5,2) + '% Procesado de la Información' NOCLEAR NOWAIT
        IF R = 65500
            FOR I = 1 TO lcuantos
                lcname=lcampos(I,1)    
                XLSheet.Cells(5,I).VALUE=lcname
                 XLSheet.Cells(5,I).FONT.NAME = "Arial"
                 XLSheet.Cells(5,I).FONT.SIZE = 10
                 XLSheet.Cells(5,I).FONT.bold = .T.
               NEXT
               XLSheet.COLUMNS.AUTOFIT
               XLSheet.Cells(1,1).VALUE= UPPER(lDescripcion)
               XLSheet.Cells(1,1).FONT.bold = .T.
               XLSheet.Cells(2,1).VALUE = FtoL(S_Fecsis)
               XLSheet.Cells(2,1).FONT.bold = .T.
            XLSheet.Cells(3,1).VALUE= lDescripcion1
               XLSheet.COLUMNS.AUTOFIT
               R=6
               lpag=lpag+1
               XLApp.Sheets(lpag).SELECT
               XLSheet = XLApp.ActiveSheet
               XLSheet.NAME=lnombre+"_"+ALLTR(STR(lpag))
         ENDIF
         FOR I=1 TO lcuantos
             lcampo=ALLTRIM(lcursor)+'.'+lcampos(I,1)
              IF TYPE('&lcampo')#'G'
                IF TYPE('&lcampo')='C'
                      XLSheet.Cells(R,I).VALUE=ALLTRIM(&lcampo)
                      XLSheet.Cells(R,I).FONT.NAME = "Arial"
                      XLSheet.Cells(R,I).FONT.SIZE = 10
                ELSE
                      IF TYPE('&lcampo')='T'
                        XLSheet.Cells(R,I).VALUE=TTOC(&lcampo)
                      ELSE
                             IF TYPE('&lcampo')='D'
                            XLSheet.Cells(R,I).VALUE=DTOC(&lcampo)
                        else
                            XLSheet.Cells(R,I).VALUE= &lcampo
                        endif
                      ENDIF
                      XLSheet.Cells(R,I).FONT.NAME = "Arial"
                      XLSheet.Cells(R,I).FONT.SIZE = 10
                ENDIF
              ENDIF
        NEXT
        R=R+1
    ENDSCAN
    FOR I = 1 TO lcuantos
        lcname=lcampos(I,1)
        XLSheet.Cells(5,I).VALUE=lcname    
        XLSheet.Cells(5,I).FONT.NAME = "Arial"
        XLSheet.Cells(5,I).FONT.SIZE = 10
        XLSheet.Cells(5,I).FONT.bold = .T.
    NEXT
    XLSheet.COLUMNS.AUTOFIT
    XLSheet.Cells(1,1).VALUE= UPPER(lDescripcion)
    XLSheet.Cells(1,1).FONT.bold = .T.
    *XLSheet.Cells(1,IIF((lcuantos-1)>0,lcuantos-1,lcuantos)).VALUE=ALLTRIM(DTOC(DATE()))
    XLSheet.Cells(2,1).VALUE=FtoL(S_Fecsis)
    XLSheet.Cells(2,1).FONT.bold = .T.
    XLSheet.Cells(3,1).VALUE = lDescripcion1
    XLSheet.COLUMNS.AUTOFIT
    WAIT WINDOWS 'Listo....' NOWAIT
    Oexcel.VISIBLE=.T.
    RETURN .T.
Endfunc

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas