Page 1 of 1

Ejemplo de Excel a DBF

Posted: Tue Jul 09, 2019 12:39 pm
by Pepe Ruano
Hola a todos los amigos y componentes del foro.
En principio desearles que estén pasando un buen y fresquito verano :D

Y ahora lo que necesito es importar datos de un archivo excel a DBF, he visto varios post por el foro, pero no lo tengo muy claro.
Por lo que lo que más agradecería sería que algún generoso que lo sepa me adjuntase un sencillo ejemplo de como se realiza conservando acentos las ñ y caracteres que existan en la hoja excel.

De antemano muchas gracias a todos y buen verano y vacaciones para quien las disfrute ;)

English translator:

Hello to all the friends and forum components.
In principle, to wish them a good and cool summer :D

And now what I need is to import data from an excel file to DBF, I've seen several posts in the forum, but I'm not sure.
So what I would most appreciate would be that some generous who knows I attached a simple example of how to do preserving accents the ñ and characters that exist in the excel sheet.

Thank you in advance for all and good summer and holidays for those who enjoy them ;)

Re: Ejemplo de Excel a DBF

Posted: Tue Jul 09, 2019 12:55 pm
by bpd2000

Re: Ejemplo de Excel a DBF

Posted: Thu Jul 11, 2019 12:30 am
by Pepe Ruano
Gracias bpd2000, pero he probado los prg y me dan errores, ese post ya lo había leido pero no me funciona a mi correctamente y lo he probado de varias formas. A ver si hay algún otro más actual y que además lea para importar archivos xlss.

Re: Ejemplo de Excel a DBF

Posted: Thu Jul 11, 2019 11:30 am
by bpd2000

Re: Ejemplo de Excel a DBF

Posted: Mon Jul 15, 2019 12:29 pm
by JALMAG
Esto me funciona...Era de un forero, si no recuerdo mal solucioné el problema de excel residente en memoria...

#include <hmg.ch>

Function Main()
DEFINE WINDOW V108 AT 10,10 WIDTH 400 HEIGHT 270 TITLE 'Ingresar TCPs desde Excel' MAIN
@210,015 BUTTON b01v108 CAPTION 'Buscar Archivo' WIDTH 90 HEIGHT 25 ACTION op108agrega()
@210,291 BUTTON b02v108 CAPTION 'Salir' WIDTH 90 HEIGHT 25 ACTION op108salida()
on key escape action op108salida()
END WINDOW
CENTER WINDOW V108
V108.b01v108.SETFOCUS
ACTIVATE WINDOW V108

Return Nil

procedure op108agrega()
Local x,y
x := Getfile ( { {'All Files','*.*'} } , 'Open File' , 'c:\' , .f. , .t. )
yx=alltrim(x)
oExcel := CreateObject( "Excel.Application")
oExcel:Workbooks:Open(yx)

******************************************************************************************************************************************************
* AQUI, SI PONGO VISIBLE EN .F., EL PROCESO FUNCIONA PERFECTO, SOLO QUE EL ARCHIVO DE EXCEL, SE QUEDA EN MEMORIA, AUN QUE FISICAMENTE NO LO PUEDA VER.
* SI LO DEJO EN .T., EL ARCHIVO DE EXCEL SE QUEDA ABIERTO.
* NECESITO UNA INSTRUCCION PARA CERRAR EL ARCHIVO DE EXCEL Y NO SE QUEDE RESIDIENDO EN RAM.
*
* HERE, IF I PUT VISIBLE IN .F., PROCESS WORKS PERFECT, BUT EXCEL FILE STAYS IN RAM.
* IF I LET IT .T., EXCEL FILE STAYS OPEN
* I NEED AN INSTRUCTION TO CLOSE EXCEL FILE AND TAKE IT OFF FROM RAM
******************************************************************************************************************************************************

oExcel:Visible := .t.


select a
use tcpren index tcpren1,tcpren2
set order to 1
go top
select b
use tcpimp index tcpimp1,tcpimp2
set order to 1
go top
i=2
K=0
do while .t.
if i>1000
exit
endif
c14=oExcel:WorkSheets(1):cells(i,14):value
if empty(c14)
exit
endif
if valtype(oExcel:WorkSheets(1):cells(i,15):value)='C'
c15=oExcel:WorkSheets(1):cells(i,15):value
else
c15=alltrim(str(int(oExcel:WorkSheets(1):cells(i,15):value)))
endif
if empty(oExcel:WorkSheets(1):cells(i,16):value)
c16=""
else
if valtype(oExcel:WorkSheets(1):cells(i,16):value)='C'
c16=oExcel:WorkSheets(1):cells(i,16):value
else
c16=alltrim(str(oExcel:WorkSheets(1):cells(i,16):value))
endif
endif
if empty(oExcel:WorkSheets(1):cells(i,17):value)
c17=""
else
if valtype(oExcel:WorkSheets(1):cells(i,17):value)='C'
c17=oExcel:WorkSheets(1):cells(i,17):value
else
c17=alltrim(str(oExcel:WorkSheets(1):cells(i,17):value))
endif
endif
if valtype(oExcel:WorkSheets(1):cells(i,18):value)='C'
c18=oExcel:WorkSheets(1):cells(i,18):value
else
c18=alltrim(str(oExcel:WorkSheets(1):cells(i,18):value))
endif
if valtype(oExcel:WorkSheets(1):cells(i,20):value)='C'
c20=oExcel:WorkSheets(1):cells(i,20):value
else
c20=alltrim(str(oExcel:WorkSheets(1):cells(i,20):value))
endif
if valtype(oExcel:WorkSheets(1):cells(i,21):value)='C'
c21=oExcel:WorkSheets(1):cells(i,21):value
else
c21=alltrim(str(int(oExcel:WorkSheets(1):cells(i,21):value)))
endif
if valtype(oExcel:WorkSheets(1):cells(i,22):value)='C'
c22=oExcel:WorkSheets(1):cells(i,22):value
else
c22=alltrim(str(oExcel:WorkSheets(1):cells(i,22):value))
endif
if valtype(oExcel:WorkSheets(1):cells(i,23):value)='C'
c23=oExcel:WorkSheets(1):cells(i,23):value
else
c23=alltrim(str(oExcel:WorkSheets(1):cells(i,23):value))
endif
if valtype(oExcel:WorkSheets(1):cells(i,24):value)='C'
c24=oExcel:WorkSheets(1):cells(i,24):value
else
c24=alltrim(str(oExcel:WorkSheets(1):cells(i,24):value))
endif
if left(c14,2)='ZR' .or. left(c14,2)='CR'
select a
else
select b
endif
seek c14
if !found()
do while .t.
if flock()
exit
endif
enddo
appe blan
repl folio with c14, orden with c15, zona with c16
repl cliente with c17, fentrada with ctod(c18), posicion with c20
repl medida with c21, marca with c22, matricula with c23, quemado with c24
unlock
K=K+1
endif
i++
enddo
use
KK=ALLTRIM(STR(INT(K)))
msginfo(kk+' Registros ingresados. Proceso terminado...')
oExcel:Quit()
op108salida()
return

procedure op108salida
V108.b01v108.release
V108.b02v108.release
thiswindow.release
return

Re: Ejemplo de Excel a DBF

Posted: Tue Jul 16, 2019 10:46 pm
by edufloriv
Saludos amigos,

Yo uso esta rutina para pasar de XLS a DBF:

Code: Select all

* ------------------------------------------------------ *
* SISTEMA     :                                          *
* PRG         :                                          *
* CREADO      :                                          *
* ACTUALIZADO :                                          *
* AUTOR       : EDUARDO V. FLORES RIVAS                  *
* COMENTARIOS :                                          *
* ------------------------------------------------------ *

PROC Proc_Xls_To_Dbf

LOCAL cOrigen := ''
LOCAL cRutaActual
LOCAL aCobDat := {;
{'ARTICOD','C', 5,0},;
{'STOCK'  ,'N',12,0}}
LOCAL cCobDat := GetDesktopFolder()+'\XLS_TO_DBF'

PRIVATE aOperas := {}

   cRutaActual := GetCurrentFolder()
   cOrigen     := GetFile( {{'Archivos de Excel 2010','*.xlsx'},{'Archivos de Excel','*.xls'}} , 'Listas de Precios' , 'XLS' )
   SetCurrentFolder(cRutaActual)

   IF ! EMPTY(cOrigen)

      DBCREATE( cCobDat , aCobDat )
      USE &cCobDat ALIAS FACDAT EXCLUSIVE NEW

      Proc_LlenarCompExcel( cOrigen )

      MsgInfo('Datos completados.')
      CLOSE FACDAT

   ENDIF

RETURN


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

PROC Proc_LlenarCompExcel
PARA cExcelOrigen

   oExcel               := CREATEOBJECT( "Excel.Application" )
   oExcel:Visible       := .F.
   oExcel:DisplayAlerts := .F.
   oWorkBook            := oExcel:WorkBooks:Open(cExcelOrigen)

   oExcel:Sheets(1):Select()
   oHoja                := oExcel:ActiveSheet
   nFilas               := oHoja:UsedRange:Rows:Count()
   nColumnas            := oHoja:UsedRange:Columns:Count()

   FOR nRow = 2 TO nFilas

      APPEND BLANK
      FACDAT->ARTICOD := Cell2Chr( oHoja:cells(nRow,1):value )
      FACDAT->STOCK   := Cell2Val( oHoja:cells(nRow,2):value )

   NEXT

   oWorkBook:Close()
   oExcel:Quit()
   oHoja     := NIL
   oWorkBook := NIL
   oExcel    := NIL
   RELEASE oHoja
   RELEASE oWorkBook
   RELEASE oExcel

RETURN


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

FUNC Cell2VAL( xCadena )

LOCAL nNumero := 0
LOCAL cTipo   := VALTYPE(xCadena)

   DO CASE
      CASE cTipo = 'C'
         nNumero := VAL( xCadena )
      CASE cTipo = 'N'
         nNumero := xCadena
      CASE cTipo = 'U'
         nNumero := 0
      OTHERWISE
         MsgInfo('Error : '+cTipo)
   ENDCASE

RETURN( nNumero )


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

FUNC Cell2CHR( xCadena )

LOCAL cCadena := ' '

   IF ! VALTYPE( xCadena ) = 'U'
      DO CASE
         CASE VALTYPE(xCadena) = 'C'
            cCadena := xCadena
         CASE VALTYPE(xCadena) = 'N'
            cCadena := VALSTR(INT(xCadena))
         CASE VALTYPE(xCadena) = 'D'
            cCadena := DTOC(xCadena)
      ENDCASE
   ENDIF

RETURN( cCadena )
Con Office 2013 hacia adelante funciona genial, el tema es con versiones anteriores de Office (2010) o cuando la licencia de Office NO esta activada, ya que aparece la ventana de solicitud de licencia.

Espero ayude, saludos cordiales a todos.

Re: Ejemplo de Excel a DBF

Posted: Wed Jul 17, 2019 11:31 pm
by Pepe Ruano
JALMAG wrote:
Mon Jul 15, 2019 12:29 pm
Esto me funciona...Era de un forero, si no recuerdo mal solucioné el problema de excel residente en memoria...
Gracias JALMAG, pero a mi no me funciona me da errores al ejecutarlo.

Re: Ejemplo de Excel a DBF

Posted: Wed Jul 17, 2019 11:38 pm
by Pepe Ruano
edufloriv wrote:
Tue Jul 16, 2019 10:46 pm
Saludos amigos,

Yo uso esta rutina para pasar de XLS a DBF:

Con Office 2013 hacia adelante funciona genial, el tema es con versiones anteriores de Office (2010) o cuando la licencia de Office NO esta activada, ya que aparece la ventana de solicitud de licencia.

Espero ayude, saludos cordiales a todos.
Muchas gracias Eduardo, tu codigo me ha servido y después de unas pequeña modificaciones que he hecho me funciona correctamente, esto era lo que quería, repito Gracias por tu ejemplo.

Aquí pongo como yo me lo he arreglado para mi por si le sirve a algún otro compañero:

Code: Select all


* ------------------------------------------------------ *
* SISTEMA     :                                          *
* PRG         :                                          *
* CREADO      :                                          *
* ACTUALIZADO :                                          *
* AUTOR       : EDUARDO V. FLORES RIVAS                  *
* COMENTARIOS : MODIFICADO POR PEPE RUANO   18/07/2019   *
* ------------------------------------------------------ *

#include "hmg.ch"

Function Main
SET FONT TO "Arial" , 10
SET LANGUAGE TO SPANISH
SET CODEPAGE TO SPANISH
SET DATE TO ITALIAN
SET DATE FORMAT TO 'dd/mm/yy'
SET EPOCH TO 1980

	DEFINE WINDOW Win_1 ;
		ROW 0 ;
		COL 0 ;
		WIDTH 400 ;
		HEIGHT 400 ;
		TITLE 'De Excel a DBF' ;
		WINDOWTYPE MAIN  ;
		ON INTERACTIVECLOSE (PlayExclamation() , MsgYesNo ('Desea salir de la aplicación ?',"Salir del Programa"))
		ON KEY ESCAPE OF PrinciGescomi ACTION Salida()

			DEFINE MAIN MENU
			POPUP 'Conversión'
				ITEM 'Covertir a DBF' ACTION Proc_Xls_To_Dbf() TOOLTIP "Covertir XLS a DBF"
				SEPARATOR
				ITEM 'Salir de la Aplicación' ACTION Salida() TOOLTIP "Salir de la Aplicación"
			END POPUP
		
			END MENU
	
	END WINDOW

	Win_1.Center

	Win_1.Activate

Return

STATIC PROC Proc_Xls_To_Dbf()

LOCAL cOrigen := ''
LOCAL cRutaActual
LOCAL aCobDat := {;  //Extructura de la BD a modificar según la hoja excel que vayamos a convertir
{'CAMPO1','C', 25,0},;
{'CAMPO2','C', 25,0},;
{'CAMPO3','N', 15,0},;
{'CAMPO4','C', 45,0},;
{'CAMPO5','C', 50,0},;
{'CAMPO6'  ,'C',10,0}}
LOCAL cCobDat := GetDesktopFolder()+'\XLS_TO_DBF'

PRIVATE aOperas := {}

   cRutaActual := GetCurrentFolder()
   cOrigen     := GetFile( {{'Archivos de Excel 2010','*.xlsx'},{'Archivos de Excel','*.xls'}} , 'Listas de Precios' , 'XLS' )
   SetCurrentFolder(cRutaActual)

   IF ! EMPTY(cOrigen)

      DBCREATE( cCobDat , aCobDat )
      USE &cCobDat ALIAS FACDAT EXCLUSIVE NEW

      Proc_LlenarCompExcel( cOrigen )

      MsgInfo('Exportación a DBf completada.'+CHR(13)+"Su archivo está en: "+GetDesktopFolder()+CHR(13)+;
				'Con el Nombre: XLS_TO_DBF.DBF',"Fin del Proceso")
      CLOSE FACDAT

   ENDIF

RETURN

*-------------------------------------------------------------------------
STATIC FUNC Proc_LlenarCompExcel(cExcelOrigen)
*-------------------------------------------------------------------------

   oExcel               := CREATEOBJECT( "Excel.Application" )
   oExcel:Visible       := .F.
   oExcel:DisplayAlerts := .F.
   oWorkBook            := oExcel:WorkBooks:Open(cExcelOrigen)

   oExcel:Sheets(1):Select()
   oHoja                := oExcel:ActiveSheet
   nFilas               := oHoja:UsedRange:Rows:Count()
   nColumnas            := oHoja:UsedRange:Columns:Count()

  MsgInfo("En total hay "+ALLTRIM(STR(nFilas))+" Filas","Numero de Filas") 
   
   FOR nRow = 2 TO nFilas

      APPEND BLANK // Modificar según la extructura que hemos creado al principio
      FACDAT->CAMPO1 := Cell2Chr( oHoja:cells(nRow,1):value )
      FACDAT->CAMPO2 := Cell2Chr( oHoja:cells(nRow,2):value )
	  FACDAT->CAMPO3 := Cell2Val( oHoja:cells(nRow,3):value )
	  FACDAT->CAMPO4 := Cell2Chr( oHoja:cells(nRow,4):value )
	  FACDAT->CAMPO5 := Cell2Chr( oHoja:cells(nRow,5):value )
	  FACDAT->CAMPO6 := Cell2Chr( oHoja:cells(nRow,6):value )
	  
   NEXT

   oWorkBook:Close()
   oExcel:Quit()
   oHoja     := NIL
   oWorkBook  := NIL
   oExcel    := NIL
   RELEASE oHoja
   RELEASE oWorkBook
   RELEASE oExcel
   

RETURN

*-------------------------------------------------------------------------
FUNC Cell2VAL( xCadena )
*-------------------------------------------------------------------------
LOCAL nNumero := 0
LOCAL cTipo   := VALTYPE(xCadena)

   DO CASE
      CASE cTipo = 'C'
         nNumero := VAL( xCadena )
      CASE cTipo = 'N'
         nNumero := xCadena
      CASE cTipo = 'U'
         nNumero := 0
      OTHERWISE
         MsgInfo('Error : '+cTipo)
   ENDCASE

RETURN( nNumero )




*-------------------------------------------------------------------------
STATIC FUNC Cell2CHR( xCadena )
*-------------------------------------------------------------------------
LOCAL cCadena := ' '

   IF ! VALTYPE( xCadena ) = 'U'
      DO CASE
         CASE VALTYPE(xCadena) = 'C'
            cCadena := xCadena
         CASE VALTYPE(xCadena) = 'N'
            cCadena := VAL(STR(INT(xCadena)))
         CASE VALTYPE(xCadena) = 'D'
            cCadena := DTOC(xCadena)
      ENDCASE
   ENDIF

RETURN( cCadena )

*-----------------------------------------------------------------------------*
STATIC Procedure Salida()	// Salimos de la aplicación
*-----------------------------------------------------------------------------*
PlayExclamation()

If MsgYesNo("Desea salir de la Aplicación ?","Salir del Programa")
	CLOSE DATABASES
	Win_1.Release
  Else
	Retu
Endif

Retu Nil