Hola a todos los amigos y componentes del foro.
En principio desearles que estén pasando un buen y fresquito verano
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
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
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.
******************************************************************************************************************************************************
* 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
* ------------------------------------------------------ *
* 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.
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.
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:
* ------------------------------------------------------ *
* 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
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 (64.59 KiB) Viewed 4674 times
A ustedes les sucede lo mismo?, alguna ayuda cómo resolver ese detalle.
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
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