Ejemplo de Excel a DBF

HMG en Español

Moderator: Rathinagiri

User avatar
Pepe Ruano
Posts: 65
Joined: Fri Aug 16, 2013 11:31 am
DBs Used: DBF
Location: Almansa, Albacete - Spain
Contact:

Ejemplo de Excel a DBF

Post 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 ;)
Saludos - Regards
Pepe Ruano
hmg.ruano.org
User avatar
bpd2000
Posts: 1207
Joined: Sat Sep 10, 2011 4:07 am
Location: India

Re: Ejemplo de Excel a DBF

Post by bpd2000 »

BPD
Convert Dream into Reality through HMG
User avatar
Pepe Ruano
Posts: 65
Joined: Fri Aug 16, 2013 11:31 am
DBs Used: DBF
Location: Almansa, Albacete - Spain
Contact:

Re: Ejemplo de Excel a DBF

Post 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.
Saludos - Regards
Pepe Ruano
hmg.ruano.org
User avatar
bpd2000
Posts: 1207
Joined: Sat Sep 10, 2011 4:07 am
Location: India

Re: Ejemplo de Excel a DBF

Post by bpd2000 »

BPD
Convert Dream into Reality through HMG
JALMAG
Posts: 262
Joined: Sun Jan 10, 2010 7:05 pm
DBs Used: DBF, MariaDB
Location: España - Spain

Re: Ejemplo de Excel a DBF

Post 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
User avatar
edufloriv
Posts: 237
Joined: Thu Nov 08, 2012 3:42 am
DBs Used: DBF, MariaDB, MySQL, MSSQL, MariaDB
Location: PERU

Re: Ejemplo de Excel a DBF

Post 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.

Eduardo Flores Rivas


LIMA - PERU
User avatar
Pepe Ruano
Posts: 65
Joined: Fri Aug 16, 2013 11:31 am
DBs Used: DBF
Location: Almansa, Albacete - Spain
Contact:

Re: Ejemplo de Excel a DBF

Post 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.
Saludos - Regards
Pepe Ruano
hmg.ruano.org
User avatar
Pepe Ruano
Posts: 65
Joined: Fri Aug 16, 2013 11:31 am
DBs Used: DBF
Location: Almansa, Albacete - Spain
Contact:

Re: Ejemplo de Excel a DBF

Post 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

Saludos - Regards
Pepe Ruano
hmg.ruano.org
jparada
Posts: 430
Joined: Fri Jan 23, 2009 5:18 pm

Re: Ejemplo de Excel a DBF

Post by jparada »

Hola,
Utilizando las funciones que comentan aquí, he tenido éxito en leer un archivo de Excel, el único detalle que tengo es que el archivo lo deja abierto Excel, porque después de correr el proceso e intentar abrir con Excel el archivo me despliega este mensaje:
img.png
img.png (64.59 KiB) Viewed 4422 times
A ustedes les sucede lo mismo?, alguna ayuda cómo resolver ese detalle.

Gracias.

Saludos,
Javier
User avatar
AUGE_OHR
Posts: 2060
Joined: Sun Aug 25, 2019 3:12 pm
DBs Used: DBF, PostgreSQL, MySQL, SQLite
Location: Hamburg, Germany

Re: Ejemplo de Excel a DBF

Post by AUGE_OHR »

hi,

this Code

Code: Select all

   nFilas               := oHoja:UsedRange:Rows:Count()
   nColumnas            := oHoja:UsedRange:Columns:Count()

   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 )
work fine but it call nFilas-1 times oHoja:cells() to read

for big Excel Sheet it can take a lot time this Way ... so try other Way

Code: Select all

   oExcel:Application:Workbooks:open(cPATH+cFILE)

   // Make the first Workbook active
   oWorkBook := oExcel:activeWorkBook

   // active 1st Sheet 
   oExcel:Application:Worksheets(1):activate()

   // Speed things up by creating an object containing the cells
   oSheet := oExcel:Worksheets(1):cells

   // select hole Range
   oWorkBook:workSheets(1):usedRange:Select

   // count ROW / COL
   numRows    := oWorkBook:workSheets(1):usedRange:Rows:Count
   numColumns := oWorkBook:workSheets(1):usedRange:Columns:Count

   // create empty Array
   FOR i := 1 TO numRows
      AADD(aExcel,ARRAY(numColumns))
   NEXT

   // convert numColumns to A-Z
   cEnde := ZAHL2CHR(numColumns)

   // fill Array this Way
   aExcel := oSheet:range( "A1:"+cEnde+LTRIM(STR(numRows)) ):value

Code: Select all

FUNCTION ZAHL2CHR(numColumns)
LOCAL nMal
LOCAL cEnde
   IF numColumns > 26
      nMal  := INT(numColumns/26)
      cEnde := CHR(nMal+64)+CHR((numColumns-(nMal*26))+64)
   ELSE
      cEnde := CHR(numColumns+64)
   ENDIF
RETURN cEnde
when have Array you can close Excel and fill your DBF from Array

have fun

p.s. when you want to fill a Excel Sheet FROM Array use this

Code: Select all

   oSheet:range( "A1:"+cEnde+LTRIM(STR(numRows)) ):value := aExcel
have fun
Jimmy
Post Reply