Jump to content
Fivewin Brasil

Importar Planilha de Excel com mais de 100.000 linhas

marcioe

By marcioe
in Programação

 Share

Recommended Posts

marcioe Explorer

marcioe

Posted
Posted

Olá amigos, boa noite

é o seguinte

Em nosso sistema temos um plano de telefonia onde todos os cooperados usam no plano da cooperativa, apos e fechamento, a operadora nos envia uma planilha de excel com todos as ligaçoes, etc.

Precisamos importar ela e gravar no nosso banco de dados

Tentei fazer assim mas dá erro Comgela, e depois aparece, o erro

STATIC FUNCTION IMPORTAR_CONTA_TELEFONICA()
	local i,nDados,cArquivo, aInconsistencias	
	LOCAL cPath, cFileName, cExtension, T_NUMERO_REGIAO
	aDados									:={}
	aInconsistencias						:={}
 	*----------------------------------------------------------------------------
 	T_LINHA_LIDA_EXCEL					:= 0
	ERROS_GRAVANDO_IMPORTACAO			:= 0
 	*----------------------------------------------------------------------------
	cArquivo:= cGetFile32("*.XLS","Escolha o Arquivo de Planilha a Importar (Conta Telefonica)")
	*----------------------------------------------------------------------------	
	IF !File(cArquivo)   
	   RETURN
	ENDIF
 	lNewFile := cArquivo
   *----------------------------------------------------------------------------
	* ESTA FUNCAO MOSTRA O CAMNINHO E NOME E EXTENSAO DO ARQUIVO PASSADO NO PATH
   HB_FNameSplit( lNewFile, @cPath, @cFileName, @cExtension )
  
	IF upper(substr(cExtension,01,04)) == '.XLS'
		IF !EMPTY(ALLTRIM(lNewFile))
			//-> Aqui leio os dados da planilha 
			LeExcel( lNewFile,@aDados, 24, {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24},1,2,,.f. )
			nDados:=Len(aDados)
	 		FOR nI = 1 to Len(	aDados )
	 			T_NOME_COOPERADO						:= aDados[nI,1]
	 			oT_NOME_COOPERADO						: Refresh()
	 			SysRefresh()
			NEXT

		ELSE
			MsgStop('Escolha Um Arquivo para Importar !',SISTEMA)
		ENDIF
	ELSE
		MsgStop('Apenas Arquivo de Planilha Podem Ser Lidos ',SISTEMA)
	ENDIF
RETURN .T.

n48qok.jpg

Aplicacao
===========
Caminho......: C:\PROJETOS\COOPERNAC\SISCOPREP.EXE (32 bits)
Tamanho......: 5,026,816 bytes
Hora de Inicio.: 0 hours 15 mins 46 secs
Error occurred at: 03/07/2016, 21:05:50
Descricao do Erro.: Erro 95644188/1722 Unknown error: CELLS
Args:
[ 1] = N 50033
[ 2] = N 10
Chamadas
===========
Chamada por: source\rtl\win32ole.prg => TOLEAUTO:CELLS(0)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\FUNCOES.PRG => LEARQEXCEL(307)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\FUNCOES.PRG => LEEXCEL(245)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\CONTROLE_CONTA_TELEFONE.PRG => IMPORTAR_CONTA_TELEFONICA(115)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\CONTROLE_CONTA_TELEFONE.PRG => (b)CADASTRO_CONTA_TELEFONICO(40)
Chamada por: .\source\classes\BUTTON.PRG => TBUTTONBMP:CLICK(176)
Chamada por: .\source\classes\CONTROL.PRG => TBUTTON:HANDLEEVENT(1411)
Chamada por: .\source\classes\BUTTONB.PRG => TBUTTONBMP:HANDLEEVENT(0)
Chamada por: C:\FWH808\source\classes\window.prg => _FWH(3398)
Chamada por: => SENDMESSAGE(0)
Chamada por: .\source\classes\DIALOG.PRG => TDIALOG:COMMAND(407)
Chamada por: => TWINDOW:HANDLEEVENT(0)
Chamada por: .\source\classes\DIALOG.PRG => TDIALOG:HANDLEEVENT(928)
Chamada por: => DIALOGBOX(0)
Chamada por: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE(273)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\CONTROLE_CONTA_TELEFONE.PRG => CADASTRO_CONTA_TELEFONICO(79)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\SISTEMA.PRG => (b)MONTA_MENU_RIBBON(1681)
Chamada por: BUTTONEX.PRG => BUTTONEX:CLICK(203)
Chamada por: BUTTONEX.PRG => (b)BUTTONEX:NEW(105)
Chamada por: C:\FWH808\source\classes\window.prg => TWINDOW:LBUTTONDOWN(1886)
Chamada por: .\source\classes\CONTROL.PRG => BUTTONEX:LBUTTONDOWN(485)
Chamada por: => TWINDOW:HANDLEEVENT(0)
Chamada por: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT(1453)
Chamada por: BUTTONEX.PRG => BUTTONEX:HANDLEEVENT(152)
Chamada por: C:\FWH808\source\classes\window.prg => _FWH(3398)
Chamada por: => WINRUN(0)
Chamada por: C:\FWH808\source\classes\window.prg => TWINDOW:ACTIVATE(952)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\SISTEMA.PRG => MAIN(570)
Link to comment
Share on other sites
Valdir Newbie

Valdir

Posted
Posted

Olá Márcio...

Aqui uso a Classe Texcel...

/*
Clase TExcel
Esta Clase usa la clase ole de Jose Jimenez
Esta clase esta desarrollada gracias a todos los aportes del foro de FiveWin
Aunque no esta terminada , es totalmente funcional.
Víctor Manuel Tomas Díaz
*/
#include "FiveWin.Ch"
CLASS TExcel
DATA oExcel
DATA oBook
DATA oSheet
DATA cFile
DATA cFont
DATA nSize
DATA lBold
DATA lItalic
DATA lUnderLine
DATA nAlign
METHOD New()
METHOD Open( cFilexls )
METHOD Create( cFilexls )
METHOD Get( nRow , nCol ,cValue )
METHOD Say( nRow , nCol , xValue ,cFont , nSize , lBold , lItalic , lUnderLine , nAlign ,nColor )
METHOD CellFormat( nRow , nCol , nBackGround )
METHOD Borders(cRange , nRow , nCol , nStyle )
METHOD Visualizar(lValue) INLINE ::oExcel:Visible := lValue
METHOD AutoFit( nCol ) INLINE ::oSheet:Columns( nCol ):AutoFit()
METHOD Save()
METHOD Print()
METHOD SetFont(cFont) INLINE ::oSheet:Cells:Font:Name := cFont
METHOD SizeFont(nSize)INLINE ::oSheet:Cells:Font:Size := 12
METHOD Font(cFont) INLINE ::cFont := cFont
METHOD Size(nSize)INLINE ::nSize := nSize
METHOD Align(nPos)INLINE ::nAlign := nPos
/*
Metodos para las propiedades de la hoja
*/
METHOD AddSheet() INLINE ::oExcel:Sheets:Add()
METHOD CopySheet() INLINE ::oExcel:Sheets:Copy()
METHOD DelSheet(cSheet) INLINE ::oExcel:Sheets(cSheet):Delete()
// cPos -> "After" | "Before"
METHOD MoveSheet(cSheet,cPos,nSheet) INLINE ::oExcel:Sheets(cSheet):Move(cPos,nSheet)
METHOD SetSheet(cSheet) INLINE ::oExcel:Sheets(cSheet):Select() , ::oSheet := ::oExcel:Get( "ActiveSheet" )
METHOD NameSheet(cSheet,cName) INLINE ::oExcel:Sheets(cSheet):Name := cName
METHOD MultiLine(nRow , nCol ) INLINE ::oSheet:Cells( nRow, nCol ):Set("WrapText",.T.)
METHOD RanMultiLine( cRange ) INLINE ::oSheet:Range( cRange ):Set("WrapText",.T.)
METHOD AddComent( nRow , nCol , cText )
METHOD Combinar( cRange ) INLINE ::oSheet:Range( cRange ):Merge()
METHOD RangeFondo( cRange , nColor )
METHOD ColumnWidth( nCol , nWidth ) INLINE ::oSheet:Columns( nCol ):Set("ColumnWidth",Alltrim(Str(nWidth)))
METHOD End()
MESSAGE Eval() METHOD eEval( cCommand )
ENDCLASS
METHOD New() CLASS TExcel
::oExcel := TOleAuto():New("Excel.Application")
RETURN( Self )
METHOD Open( cFilexls ) CLASS TExcel
::cFile := cFilexls
::oExcel:WorkBooks:Open( ::cFile )
::oBook := ::oExcel:Get( "ActiveWorkBook")
::oSheet := ::oExcel:Get( "ActiveSheet" )
::cFont := "Arial"
::nSize := 10
::lBold := .F.
::lItalic := .F.
::lUnderLine := .F.
::nAlign := 1
RETURN( Nil )
METHOD Create( cFilexls ) CLASS TExcel
::cFile := cFilexls
::oExcel:WorkBooks:Add()
::oBook := ::oExcel:Get( "ActiveWorkBook")
::oSheet := ::oExcel:Get( "ActiveSheet" )
::cFont := "Arial"
::nSize := 10
::lBold := .F.
::lItalic := .F.
::lUnderLine := .F.
::nAlign := 1
RETURN( Nil )
METHOD Get( nRow , nCol , cValue ) CLASS TExcel
LOCAL xVret
LOCAL cType
DEFAULT cValue := Nil
xVret := ::oSheet:Cells( nRow, nCol ):Value
xVret := IIF( ValType( xVret )=="U", "" , xVret )
cType := ValType( xVret )
IF cValue != Nil
IF cValue == "N"
xVret := IIF( ValType( xVret )=="C",Val(xVret) ,;
IIF( ValType( xVret )=="D",xVret ,xVret ) )
ENDIF
IF cValue == "C"
xVret := IIF( ValType( xVret )=="N",Ltrim(Str(xVret) ),;
IIF( ValType( xVret )=="D",Dtos(xVret) ,xVret ) )
ENDIF
ENDIF
RETURN( xVret )
METHOD RangeFondo( cRange , nColor ) CLASS TExcel
DEFAULT nColor := Rgb(255 , 255 , 255 )
::oSheet:Range( cRange ):Interior:Color := nColor
RETURN( Nil )
METHOD Borders( cRange , nRow , nCol , nStyle ) CLASS TExcel
IF Empty( cRange )
::oSheet:Cells( nRow, nCol ):Borders():LineStyle := nStyle
ELSE
::oSheet:Range( cRange ):Borders():LineStyle := nStyle
ENDIF
RETURN( Nil )
METHOD CellFormat( nRow , nCol , nColor , nLine ) CLASS TExcel
DEFAULT nColor := Rgb(255 , 255 , 255 )
::oSheet:Cells( nRow, nCol ):Interior:Color := nColor
//::oSheet:Cells( nRow, nCol ):Interior:Pattern := 2
//::oSheet:Cells( nRow, nCol ):Borders(nLine):LineStyle := 1 // Bottom
RETURN( Nil )
METHOD AddComent( nRow , nCol , cText ) CLASS TExcel
DEFAULT cText := ""
IF !Empty( cText )
::oSheet:Cells( nRow, nCol ):AddComment(cText)
ENDIF
RETURN( Nil )
METHOD Print() CLASS TExcel
::oSheet:PrintOut()
RETURN( Nil )
METHOD Say( nRow , nCol , xValue ,cFont , nSize , lBold , lItalic , lUnderLine , nAlign ,nColor ) CLASS TExcel
* nAlign -> 1 // Derecha
* nAlign -> 4 // Izquierda
* nAlign -> 7 // Centrado
LOCAL xVret
DEFAULT cFont := ::cFont
DEFAULT nSize := ::nSize
DEFAULT lBold := ::lBold
DEFAULT lItalic := ::lItalic
DEFAULT lUnderLine := ::lUnderLine
DEFAULT nAlign := ::nAlign
DEFAULT nColor := Rgb( 0 , 0 , 0)
::oSheet:Cells( nRow, nCol ):Font:Name := cFont
::oSheet:Cells( nRow, nCol ):Font:Size := nSize
::oSheet:Cells( nRow, nCol ):Font:Bold := lBold
::oSheet:Cells( nRow, nCol ):Font:Italic := lItalic
::oSheet:Cells( nRow, nCol ):Font:UnderLine := lUnderLine
::oSheet:Cells( nRow, nCol ):Font:Color := nColor
::oSheet:Cells( nRow, nCol ):Value := xValue
::oSheet:Cells( nRow, nCol ):Interior:Color := RGB( 255, 255, 255 )
::oSheet:Cells( nRow, nCol ):Set("HorizontalAlignment",Alltrim(Str(nAlign)))
RETURN( Nil )
METHOD Save() CLASS TExcel
// Falta
RETURN( Nil )
METHOD End() CLASS TExcel
::oExcel:End()
::oBook:End()
::oSheet:End()
::oExcel := NIL
::oBook := NIL
::oSheet := NIL
RETURN( Nil )
METHOD eEval( cCommand ) CLASS TExcel
private oThis := Self
Eval( &("{|| oThis:" + cCommand + "}" ) )
release oThis
RETURN( Nil )
Espero que te ajude.
abrs.
Link to comment
Share on other sites
Valdir Newbie

Valdir

Posted
Posted

Olá Márcio...

Veja este exemplo.

// funcao: Converte Planilhas em Excel p/ DBF
// data: 17/11/2006
// Guilherme J.S. Gon‡alves
#include 'fivewin.ch'
FUNCTION Main()
MsgRun("Convertendo planilha...", "Aguarde...", {|| LeExcel() } )
return NIL
function LeExcel( cArquivo ) // Se o nome do arquivo nÆo for passado
// ele abre uma GetFile()
local oExcel, oFolha, oWork, oWnd
local cArqDBF, cLinha
local nLinhas, nColunas, nColObrig, nFolhas
local aDados, aCol, aEstru
local xValue
local n, i
nColObrig:=1
aCol:={}
aDados:={}
aEstru:={}
if cArquivo==NIL
cArquivo := cGetFile( "*.xls" , "Selecione o arquivo..." )
endif
oExcel := TOleAuto():New( "Excel.Application" )
oExcel:Workbooks:Add()
oExcel:Workbooks:Open( cArquivo )
oFolha := oExcel:Get( 'ActiveSheet' )
oWork := oExcel:Get( 'ActiveWorkbook' )
oWork:Saved := .T.
oWnd := oExcel:Get( 'ActiveWindow' )
nLinhas := oFolha:UsedRange:Rows:Count()
nColunas := oFolha:UsedRange:Columns:Count()
n:=1
i:=1
cArqDbf:=alltrim('EXCEL.DBF')
if file(cArqDbf)
ferase(cArqDbf)
endif
if file("EXCEL.DBF")
fErase("EXCEL.DBF")
endif
for i=1 to nColunas
aadd(aEstru,{"CAMPO"+alltrim(str(i)),"C",250,0})
next i
DBCreate(cArqDbf,aEstru)
select 1
use EXCEL.DBF alias DB new
i:=1
for n=1 to nLinhas
for i=1 to nColunas
if i==1
append blank
endif
if oFolha:Cells( n, i ):Value==NIL
xValue:=SPACE(250)
else
xValue:=oFolha:Cells( n, i):Value
endif
IF VALTYPE(xValue)<>'C'
replace &("CAMPO"+alltrim(str(i))) with Str(xValue,15,2)
ELSE
replace &("CAMPO"+alltrim(str(i))) with xValue
ENDIF
next i
next n
MsgInfo(OemToAnsi("Planilha do Excel convertida com sucesso..."), OemToAnsi("ATENۂO..."))
use
oExcel:Workbooks:Close()
oExcel:Quit()
Release All
return NIL
Abrs
Link to comment
Share on other sites
marcioe Explorer

marcioe

Posted
  • Author
Posted

AMIGÃO FIZ DESTA FORMA

STATIC FUNCTION IMPORTAR_CONTA_TELEFONICA()
	cFile:=cGetFile32("*.XLS","Escolha o Arquivo de Planilha a Importar (Conta Telefonica)")
	 MsgRun("Convertendo planilha...", "Aguarde...", {|| LeExcel_2(cFile) } )
RETURN .T.  




function LeExcel_2( cArquivo ) // Se o nome do arquivo nÆo for passado
                               // ele abre uma GetFile()
   local oExcel, oFolha, oWork, oWnd
   local cArqDBF, cLinha
   local nLinhas, nColunas, nColObrig, nFolhas
   local aDados, aCol, aEstru
   local xValue
   local n, i
 
   nColObrig:=1
   aCol:={}
   aDados:={}
   aEstru:={}
 
   if cArquivo==NIL
     cArquivo := cGetFile( "*.xls" , "Selecione o arquivo..." )
   endif
 
   oExcel := TOleAuto():New( "Excel.Application" )
 
   oExcel:Workbooks:Add()
   oExcel:Workbooks:Open( cArquivo )
 
   oFolha      := oExcel:Get( 'ActiveSheet' )
   oWork       := oExcel:Get( 'ActiveWorkbook' )
   oWork:Saved := .T.
   oWnd        := oExcel:Get( 'ActiveWindow' )
   nLinhas     := oFolha:UsedRange:Rows:Count()
   nColunas    := oFolha:UsedRange:Columns:Count()
 
   n:=1
   i:=1
 
   cArqDbf:=alltrim('EXCEL.DBF')
 
   if file(cArqDbf)
      ferase(cArqDbf)
   endif
 
   if file("EXCEL.DBF")
      fErase("EXCEL.DBF")
   endif
 
   for i=1 to nColunas
 
      aadd(aEstru,{"CAMPO"+alltrim(str(i)),"C",250,0})
 
   next i
 
   DBCreate(cArqDbf,aEstru)
 
   select 1
   use EXCEL.DBF alias DB new
 
   i:=1
 
 
   for n=1 to nLinhas
 
      for i=1 to nColunas
            if i==1
               append blank
            endif
 
            if oFolha:Cells( n, i ):Value==NIL
               xValue:=SPACE(250)
            else
               xValue:=oFolha:Cells( n, i):Value
            endif
 
            IF VALTYPE(xValue)<>'C'
               replace &("CAMPO"+alltrim(str(i))) with Str(xValue,15,2)
              ELSE
               replace &("CAMPO"+alltrim(str(i))) with xValue
            ENDIF
 
      next i
 
   next n
 
   MsgInfo(OemToAnsi("Planilha do Excel convertida com sucesso..."), OemToAnsi("ATENۂO..."))
   use
 
   oExcel:Workbooks:Close()
   oExcel:Quit()
 
   Release All
 
return NIL

DÁ O ERRO 

Aplicacao
===========
   Caminho......: C:\PROJETOS\COOPERNAC\SISCOPREP.EXE (32 bits)
   Tamanho......: 5,028,352 bytes
   Hora de Inicio.: 0 hours 3 mins 20 secs 
   Error occurred at: 04/07/2016, 13:31:02
  Descricao do Erro.: Erro  98295188/424  Unknown error: CELLS
   Args:
     [   1] = N   2368
     [   2] = N   1

Chamadas
===========
   Chamada por: source\rtl\win32ole.prg => TOLEAUTO:CELLS(0)
   Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\CONTROLE_CONTA_TELEFONE.PRG => LEEXCEL_2(166)
   Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\CONTROLE_CONTA_TELEFONE.PRG => (b)IMPORTAR_CONTA_TELEFONICA(99)
   Chamada por: .\source\function\MSGRUN.PRG => (b)MSGRUN(0)
   Chamada por: .\source\classes\DIALOG.PRG => (b)TDIALOG:TDIALOG(86)
   Chamada por:  => TDIALOG:DISPLAY(0)
   Chamada por: .\source\classes\DIALOG.PRG => TDIALOG:HANDLEEVENT(915)
   Chamada por:  => DIALOGBOXINDIRECT(0)
   Chamada por: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE(273)
   Chamada por: .\source\function\MSGRUN.PRG => MSGRUN(0)
   Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\CONTROLE_CONTA_TELEFONE.PRG => IMPORTAR_CONTA_TELEFONICA(99)
   Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\CONTROLE_CONTA_TELEFONE.PRG => (b)CADASTRO_CONTA_TELEFONICO(40)
   Chamada por: .\source\classes\BUTTON.PRG => TBUTTONBMP:CLICK(176)
   Chamada por: .\source\classes\CONTROL.PRG => TBUTTON:HANDLEEVENT(1411)
   Chamada por: .\source\classes\BUTTONB.PRG => TBUTTONBMP:HANDLEEVENT(0)
   Chamada por: C:\FWH808\source\classes\window.prg => _FWH(3398)
   Chamada por:  => SENDMESSAGE(0)
   Chamada por: .\source\classes\DIALOG.PRG => TDIALOG:COMMAND(407)
   Chamada por:  => TWINDOW:HANDLEEVENT(0)
   Chamada por: .\source\classes\DIALOG.PRG => TDIALOG:HANDLEEVENT(928)
   Chamada por:  => DIALOGBOX(0)
   Chamada por: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE(273)
   Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\CONTROLE_CONTA_TELEFONE.PRG => CADASTRO_CONTA_TELEFONICO(79)
   Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\SISTEMA.PRG => (b)MONTA_MENU_RIBBON(1681)
   Chamada por: BUTTONEX.PRG => BUTTONEX:CLICK(203)
   Chamada por: BUTTONEX.PRG => (b)BUTTONEX:NEW(105)
   Chamada por: C:\FWH808\source\classes\window.prg => TWINDOW:LBUTTONDOWN(1886)
   Chamada por: .\source\classes\CONTROL.PRG => BUTTONEX:LBUTTONDOWN(485)
   Chamada por:  => TWINDOW:HANDLEEVENT(0)
   Chamada por: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT(1453)
   Chamada por: BUTTONEX.PRG => BUTTONEX:HANDLEEVENT(152)
   Chamada por: C:\FWH808\source\classes\window.prg => _FWH(3398)
   Chamada por:  => WINRUN(0)
   Chamada por: C:\FWH808\source\classes\window.prg => TWINDOW:ACTIVATE(952)
   Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\SISTEMA.PRG => MAIN(570)
Link to comment
Share on other sites
emotta Apprentice

emotta

Posted
Posted

Sugestão: Salve a planilha em CVS, com as colunas separadas por virgula, e ai faça a importação no seu sistema sem precisar do EXCEL.

Será muito mais rápido e vai evitar esse problema...

Olá amigos, boa noite

é o seguinte

Em nosso sistema temos um plano de telefonia onde todos os cooperados usam no plano da cooperativa, apos e fechamento, a operadora nos envia uma planilha de excel com todos as ligaçoes, etc.

Precisamos importar ela e gravar no nosso banco de dados

Tentei fazer assim mas dá erro Comgela, e depois aparece, o erro

STATIC FUNCTION IMPORTAR_CONTA_TELEFONICA()
	local i,nDados,cArquivo, aInconsistencias	
	LOCAL cPath, cFileName, cExtension, T_NUMERO_REGIAO
	aDados									:={}
	aInconsistencias						:={}
 	*----------------------------------------------------------------------------
 	T_LINHA_LIDA_EXCEL					:= 0
	ERROS_GRAVANDO_IMPORTACAO			:= 0
 	*----------------------------------------------------------------------------
	cArquivo:= cGetFile32("*.XLS","Escolha o Arquivo de Planilha a Importar (Conta Telefonica)")
	*----------------------------------------------------------------------------	
	IF !File(cArquivo)   
	   RETURN
	ENDIF
 	lNewFile := cArquivo
   *----------------------------------------------------------------------------
	* ESTA FUNCAO MOSTRA O CAMNINHO E NOME E EXTENSAO DO ARQUIVO PASSADO NO PATH
   HB_FNameSplit( lNewFile, @cPath, @cFileName, @cExtension )
  
	IF upper(substr(cExtension,01,04)) == '.XLS'
		IF !EMPTY(ALLTRIM(lNewFile))
			//-> Aqui leio os dados da planilha 
			LeExcel( lNewFile,@aDados, 24, {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24},1,2,,.f. )
			nDados:=Len(aDados)
	 		FOR nI = 1 to Len(	aDados )
	 			T_NOME_COOPERADO						:= aDados[nI,1]
	 			oT_NOME_COOPERADO						: Refresh()
	 			SysRefresh()
			NEXT

		ELSE
			MsgStop('Escolha Um Arquivo para Importar !',SISTEMA)
		ENDIF
	ELSE
		MsgStop('Apenas Arquivo de Planilha Podem Ser Lidos ',SISTEMA)
	ENDIF
RETURN .T.

n48qok.jpg

Aplicacao
===========
Caminho......: C:\PROJETOS\COOPERNAC\SISCOPREP.EXE (32 bits)
Tamanho......: 5,026,816 bytes
Hora de Inicio.: 0 hours 15 mins 46 secs
Error occurred at: 03/07/2016, 21:05:50
Descricao do Erro.: Erro 95644188/1722 Unknown error: CELLS
Args:
[ 1] = N 50033
[ 2] = N 10
Chamadas
===========
Chamada por: source\rtl\win32ole.prg => TOLEAUTO:CELLS(0)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\FUNCOES.PRG => LEARQEXCEL(307)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\FUNCOES.PRG => LEEXCEL(245)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\CONTROLE_CONTA_TELEFONE.PRG => IMPORTAR_CONTA_TELEFONICA(115)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\CONTROLE_CONTA_TELEFONE.PRG => (b)CADASTRO_CONTA_TELEFONICO(40)
Chamada por: .\source\classes\BUTTON.PRG => TBUTTONBMP:CLICK(176)
Chamada por: .\source\classes\CONTROL.PRG => TBUTTON:HANDLEEVENT(1411)
Chamada por: .\source\classes\BUTTONB.PRG => TBUTTONBMP:HANDLEEVENT(0)
Chamada por: C:\FWH808\source\classes\window.prg => _FWH(3398)
Chamada por: => SENDMESSAGE(0)
Chamada por: .\source\classes\DIALOG.PRG => TDIALOG:COMMAND(407)
Chamada por: => TWINDOW:HANDLEEVENT(0)
Chamada por: .\source\classes\DIALOG.PRG => TDIALOG:HANDLEEVENT(928)
Chamada por: => DIALOGBOX(0)
Chamada por: .\source\classes\DIALOG.PRG => TDIALOG:ACTIVATE(273)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\CONTROLE_CONTA_TELEFONE.PRG => CADASTRO_CONTA_TELEFONICO(79)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\SISTEMA.PRG => (b)MONTA_MENU_RIBBON(1681)
Chamada por: BUTTONEX.PRG => BUTTONEX:CLICK(203)
Chamada por: BUTTONEX.PRG => (b)BUTTONEX:NEW(105)
Chamada por: C:\FWH808\source\classes\window.prg => TWINDOW:LBUTTONDOWN(1886)
Chamada por: .\source\classes\CONTROL.PRG => BUTTONEX:LBUTTONDOWN(485)
Chamada por: => TWINDOW:HANDLEEVENT(0)
Chamada por: .\source\classes\CONTROL.PRG => TCONTROL:HANDLEEVENT(1453)
Chamada por: BUTTONEX.PRG => BUTTONEX:HANDLEEVENT(152)
Chamada por: C:\FWH808\source\classes\window.prg => _FWH(3398)
Chamada por: => WINRUN(0)
Chamada por: C:\FWH808\source\classes\window.prg => TWINDOW:ACTIVATE(952)
Chamada por: C:\PROJETOS\COOPERNAC\PRG_OBJ\SISTEMA.PRG => MAIN(570)
Link to comment
Share on other sites
marcioe Explorer

marcioe

Posted
  • Author
Posted

olá amigo Eduardo Motta -já tinha pensado nisso, mas o problema é que a planilha vem assim da operadora, e imagina ensinar a usuarios tapados a fazer esta conversao.

será complicado, se nao achar como resolver vai ser o caminho esse mesmo, mas o ideal seria o Usuario receber a planilha e ler ela sem ter que mexer.

Mas de qualquer forma agradeço a sua dica. (vai ficar guardada) como uma segunda opção.

Link to comment
Share on other sites
emotta Apprentice

emotta

Posted
Posted

Entendi e imaginei que vc teria esse problema... rs...

Vou procurar algum utilitario que converta XLS para CSV e se encontrar te mando, ai vc executa em seu sistema.

Abraços

olá amigo Eduardo Motta -já tinha pensado nisso, mas o problema é que a planilha vem assim da operadora, e imagina ensinar a usuarios tapados a fazer esta conversao.

será complicado, se nao achar como resolver vai ser o caminho esse mesmo, mas o ideal seria o Usuario receber a planilha e ler ela sem ter que mexer.

Mas de qualquer forma agradeço a sua dica. (vai ficar guardada) como uma segunda opção.

Link to comment
Share on other sites
emotta Apprentice

emotta

Posted
Posted

Encontrei este fonte, está em ADVPL mas a sintaxe é a mesma do xHarbour então divirta-se... Ela converte para DBF o que é ainda melhor.

o segredo me parece ser o utilitário LIBREOFFICE.

http://terminaldeinformacao.com/2015/12/03/funcao-que-converte-excel-xls-para-dbf-em-advpl/

manda ver e se der certo avisa !

abraços

Entendi e imaginei que vc teria esse problema... rs...

Vou procurar algum utilitario que converta XLS para CSV e se encontrar te mando, ai vc executa em seu sistema.

Abraços

Link to comment
Share on other sites
Edu Newbie

Edu

Posted
Posted

Bom dia!

Tente exportar direto do excel para DBF. Lembrando que o nome das colunas não podem ultrapassar de 10 caracteres.

>> Salvar arquivo xls em dbf
* Baixar o suplemento do excel. Arquivo SaveDBFIV.xlam (suplemento do Excel para exportar DBF)
* Ao fazer o download do arquivo SaveDBFIV.xlam, descompacte-o e coloque-o na pasta
C:\Users\Nome do usuário\AppData\Roaming\Microsoft\Suplementos ou outra utilizada
para complementos, AddIns e suplementos (dependendo do sistema operacional, a localização da pasta pode ser diferente).
* Clicar no botão Office ou menu Arquivo, dependendo da versão do Office.
Selecionar a opção Suplementos. Clicar no botão Ir...
Clicar em Procurar...
Selecionar o arquivo baixado e confirmar.
* Agora só salvar como o arquivo ou Arquivo -> Suplementos e selecionar o DBF no tipo do arquivo.
Link to comment
Share on other sites
emotta Apprentice

emotta

Posted
Posted

Ja foi sugerido isso acima mas ele não quer deixar isso na mão do usuário...

Bom dia!

Tente exportar direto do excel para DBF. Lembrando que o nome das colunas não podem ultrapassar de 10 caracteres.

>> Salvar arquivo xls em dbf
* Baixar o suplemento do excel. Arquivo SaveDBFIV.xlam (suplemento do Excel para exportar DBF)
* Ao fazer o download do arquivo SaveDBFIV.xlam, descompacte-o e coloque-o na pasta
C:\Users\Nome do usuário\AppData\Roaming\Microsoft\Suplementos ou outra utilizada
para complementos, AddIns e suplementos (dependendo do sistema operacional, a localização da pasta pode ser diferente).
* Clicar no botão Office ou menu Arquivo, dependendo da versão do Office.
Selecionar a opção Suplementos. Clicar no botão Ir...
Clicar em Procurar...
Selecionar o arquivo baixado e confirmar.
* Agora só salvar como o arquivo ou Arquivo -> Suplementos e selecionar o DBF no tipo do arquivo.
Link to comment
Share on other sites
marcioe Explorer

marcioe

Posted
  • Author
Posted

eu assim se eu "picar a planilha" ou seja em unas 05 arquivos com 20.000 linha ele lê, pelo que vi é gerenciamento de memoria + excel.

to tentando fazer a funcao que e-mota indicou, trocando algumas funcoes do ADVPL para do xhb.

Mas se tiver alguma outra ideia agradeço..

Link to comment
Share on other sites
Jmsilva Apprentice

Jmsilva

Posted
Posted

Marcioe, eu tenho sistema que possui diversas interfaces de comunicação de dados de leitura e exportação com outros sistemas, entre as soluções que testei, foi uma criado por mim, trata-se de uma classe baseada no LibreOffice, veja link http://fivewin.com.br/index.php?/topic/21758-gerar-planilha-no-openoffice/?hl=tcalc#entry263626,

para usá-la precisa ter o respectivo pacote instalado.

O grande problema que encontrei ao importar uma planilha ou .CSV, estavam relacionados ao tratamento de erros, aparece cada um...., mas tudo superado.

Bom que vc já resolveu, fica aqui a minha dica caso queira testar talvez um pouco tarde.

JMSILVA

em tempo, quando postei o código não havia cria o método :GetText()

oPLAN := TCalc():Open(path+nome planilha)
progres_(1) //cria a barra
//Ne exemplo os dados estão a partir da lina 10
FOR nLIN:=10 TO 1000
cNOME := oPLAN:GetText("A",nLIN) //coluna nome
cTELEFONE := oPLAN:GetText("B",nLIN) // telefone
//trata o valor e grava
progres_(2) //preenche a barra
next
progres_(3) //fecha a barra

/*Autor: Jose Maria da Silva - nick JMSILVA
** Termo uso: livre, preservar a autoria
*/


#include "FiveWin.ch"
//#include "constant.ch"
#DEFINE CH_PICTMIX 0       //QQ DADO
#DEFINE CH_PICTDTA 36      //DATA 36=MMDDAAAA 37=MMDDAA
#DEFINE CH_PICTINT 1       //NUM INT
#DEFINE CH_PICTSTR 100     //STRING
#DEFINE CH_PICTDNH 104      //NUM R$
#DEFINE CH_PICTPOR 11      //% 99.99
#DEFINE CH_PICTD02 2       //#,00
#DEFINE CH_PICTD03 156       //#,##0
//----------------------------------------------------------------------------//

**==============================================================================
CLASS TCalc //FROM TControl
**==============================================================================
  DATA oService,;
       oArquivo,;
       oDesktop,;
       oVista,;
       oAllPlan,;
       oPlan,;
       oColl

   DATA nPlanSele //PROTECTED
   DATA cFile //PROTECTED
   DATA cFileOut  INIT "Plan_"+STRZERO(HB_RandomInt(999),3) PROTECTED  //so nome
   DATA cPathOut  INIT "C:\CORREIO"


   METHOD New( lHide ) CONSTRUCTOR
   METHOD Open( lHide, cFILE ) CONSTRUCTOR
   //METHOD Plan( lHide, cFILE ) CONSTRUCTOR

   METHOD Close() INLINE ::oArquivo:Close(.T.)

   METHOD SetText( cCol, nRow, cText, nFont, nAlign )
   METHOD GetText(cCol, nRow )

   METHOD SetDate( cCol, nRow, dData, nFont, nAlign )

   METHOD SetValor( cCol, nRow, nValor, nFont, nAlign )

   METHOD SetLongLat( cCol, nRow, cGPS, nFont, nAlign )

   METHOD CharColor( cCol, nRow, nRGB )    //cor letra

   METHOD BrushColor( cCol, nRow, nRGB )   //cor do fundo

   METHOD MesclarCell( cCell )   //A1:C2

   METHOD FileOut( )
   //alinhamento vertical e horizontal
   //get
   //salvar  xls,ods,pdf
   METHOD Salvar_ODS()
   METHOD Salvar_XLS()
   METHOD Salvar_PDF()

   //borda
   //falta o decimal numero
   METHOD ArrayPlan()


ENDCLASS

//----------------------------------------------------------------------------//
**==============================================================================
METHOD New( lHide ) CLASS TCalc
**==============================================================================
   LOCAL aProp:={}

   DEFAULT lHide := .T.

   TRY //isto é show
     ::oService := TOleAuto():New("com.sun.star.ServiceManager")
   CATCH
     RETURN NIL
   END
   // inicializa processo de criar planilha A1=0,0, B1=0,1
   ::oDesktop := ::oService:createInstance("com.sun.star.frame.Desktop")
   IF lHide
      AAdd(aProp,MakeProperty(::oService,"Hidden",.T.))    //oculta
   ENDIF
   ::oArquivo := ::oDesktop:loadComponentFromURL("private:factory/scalc","_blank",0,aProp)
   ::oVista = ::oArquivo:getCurrentController()  //obj controlador

   // obtém planilhas
   ::oAllPlan := ::oArquivo:GetSheets()
   ::oAllPlan:insertNewByName("Plan_SAA",0)  //inseri uma nova planilha
   ::oPlan := ::oAllPlan:GetByIndex(0)
   ::nPlanSele := 0
   ::oColl := ::oPlan:getColumns()  //obtem as colunas
   //::cFileOut := STRZERO(HB_RandomInt(999),3)
   ::cFile    := "C:\CORREIO\PLAN_"+::cFileOut

return Self

**==============================================================================
METHOD Open(cFile ) CLASS TCalc
**==============================================================================
LOCAL nCT,aProp:={},cTemp

TRY //isto é show
  ::oService := TOleAuto():New("com.sun.star.ServiceManager")
CATCH
  MSGSTOP("Desculpe, para usar este sistema precisa ter o BrOffice instalado.","xPlan")
  RETURN NIL
END

IF EMPTY(cFile) .OR. !FILE(cFile)
      RETURN NIL
ENDIF


cTemp := "file:///"+StrTran(cFile,"\","/")


::oDesktop := ::oService:createInstance("com.sun.star.frame.Desktop")
AAdd(aProp,MakePropertyValue(::oService,"Hidden",.T.))    //oculta
::oArquivo := ::oDesktop:loadComponentFromURL(cTemp, "_blank", 0, aProp)
//::oVista   := ::oArquivo:getCurrentController()  //obj controlador

//obtém todas as planilhas do arquivo
::oAllPlan := ::oArquivo:GetSheets()
::oPlan := ::oAllPlan:getByIndex(0)

//MsgStop(::oPlan:GetName())

::oPlan   := ::oAllPlan:GetByIndex(0)
::nPlanSele := 0
::oColl := ::oPlan:getColumns()  //obtem as colunas
::cFile := cFile   //drive,path,nome


return Self


**==============================================================================
METHOD SetText(cCol, nRow, cText, nFont, nAlign ) CLASS TCalc
**==============================================================================
   local oCell,nCOL
   DEFAULT nFont := 12, nAlign := 1

   if empty(cCol) .or. empty(nRow) .or. empty(cText)
      return .f.
   endif
   cText := StrTran(cText,"§", "º ")
   cText := StrTran(cText,"¦", "ª ")

   nCOL := ASC(cCOL) - 65
   oCell := ::oPlan:getCellByPosition(nCOL,nROW-1)  //coluna, linha - posiciona
   oCell:SetString(cText)  //grava na celula (a:1)
   oCell:CharHeight := nFont
   oCell:HoriJustify := nAlign

return .t.

**==============================================================================
METHOD GetText(cCol, nRow ) CLASS TCalc
**==============================================================================
  local oCell,nCOL

  nCOL := ASC(cCol) - 65

  oCell := ::oPlan:getCellByPosition(nCOL,nRow)  //coluna, linha - posiciona

Return(AllTrim(oCell:GetString()))

**==============================================================================
METHOD SetDate(cCol, nRow, dData, nFont, nAlign ) CLASS TCalc
**==============================================================================
   local oCell,nCOL
   DEFAULT nFont := 12, nAlign := 2

   if empty(cCol) .or. empty(nRow) .or. empty(dData)
      return .f.
   endif

   nCOL := ASC(cCOL) - 65
   oCell := ::oPlan:getCellByPosition(nCOL,nROW-1)  //coluna, linha - posiciona
   oCell:SetFormula(FORMAT_DATA(dData)) //oCell:SetFormula := FORMAT_DATA(dData)
   oCell:NumberFormat := CH_PICTDTA
   oCell:CharHeight   := nFont
   oCell:HoriJustify  := nAlign
   ::oColl:GetByName(cCol):Width := 2500

return .t.

**==============================================================================
METHOD SetValor(cCol, nRow, nValor, nFont, nAlign ) CLASS TCalc
**==============================================================================
   local oCell,nCOL
   DEFAULT nFont := 12, nAlign := 3, nValor := 0

   if empty(cCol) .or. empty(nRow) //.or. empty(nValor)
      return .f.
   endif

   nCOL := ASC(cCOL) - 65
   oCell := ::oPlan:getCellByPosition(nCOL,nROW-1)  //coluna, linha - posiciona
   oCell:SetValue(nValor)
   oCell:NumberFormat := CH_PICTD03  //156
   oCell:CharHeight   := nFont
   oCell:HoriJustify  := nAlign
   ::oColl:GetByName(cCol):Width := 2000

return .t.

**==============================================================================
METHOD SetLongLat(cCol, nRow, cGPS, nFont, nAlign ) CLASS TCalc
**==============================================================================
   local oCell,nCOL
   DEFAULT nFont := 12, nAlign := 2

   if empty(cCol) .or. empty(nRow) .or. empty(cGPS)
      return .f.
   endif

   nCOL := ASC(cCOL) - 65
   oCell := ::oPlan:getCellByPosition(nCOL,nROW-1)  //coluna, linha - posiciona
   oCell:SetString(TRANSFORM(cGPS,"@R 99º 99' 99.99''"))
   oCell:CharHeight   := nFont
   oCell:HoriJustify  := nAlign
   ::oColl:GetByName(cCol):Width := 3000

return .t.

**==============================================================================
METHOD CharColor(cCol, nRow, nCor ) CLASS TCalc
**==============================================================================
   local oCell,nCOL

   if empty(cCol) .or. empty(nRow) .or. empty(nCor)
      return .f.
   endif

   nCOL := ASC(cCOL) - 65
   oCell := ::oPlan:getCellByPosition(nCOL,nROW-1)  //coluna, linha - posiciona
   oCell:CharColor := nCOR                    //cor da letra

return .t.

**==============================================================================
METHOD BrushColor(cCol, nRow, nCor ) CLASS TCalc
**==============================================================================
    local oCell,nCOL

   if empty(cCol) .or. empty(nRow) .or. empty(nCor)
      return .f.
   endif

   nCOL := ASC(cCOL) - 65
   oCell := ::oPlan:getCellByPosition(nCOL,nROW-1)  //coluna, linha - posiciona
   oCell:CellBackColor := nCOR                   //cor da letra

return .t.

**==============================================================================
METHOD MesclarCell(cCell ) CLASS TCalc
**==============================================================================
   local oRange

   if empty(cCell) .or. at(":",cCell) == 0
      return .f.
   endif

   oRange = ::oPLAN:getCellRangeByName(cCell) //Mesclar
   oRange:Merge(.T.)

return .t.

**==============================================================================
METHOD ArrayPlan() CLASS TCalc
**==============================================================================
   local aNomePlan:={},nCT,oPlan

   FOR nCT:=1 TO ::oAllPlan:Count
       oPlan := ::oAllPlan:getByIndex(nCT-1)
       AADD(aNomePlan,oPlan:GetName())
   NEXT
return aNomePlan

**==============================================================================
METHOD SALVAR_ODS() CLASS TCalc
**==============================================================================
   LOCAL cFILE
   cFILE := "file:///"+StrTran(::cPathOut,"\","/")+"/"+::cFileOut+".ODS"

   ::oArquivo:storeToURL(cFILE, {})

return nil

**==============================================================================
METHOD SALVAR_XLS() CLASS TCalc
**==============================================================================
   local cFILE,oTip
   cFILE := "file:///"+StrTran(::cPathOut,"\","/")+"/"+::cFileOut+".XLS"

   oTip := MakeProperty(::oService, "FilterName", "MS Excel 97")

   ::oArquivo:storeToURL(cFILE, {oTIP})
return nil

**==============================================================================
METHOD SALVAR_PDF() CLASS TCalc
**==============================================================================
   local cFILE,oTip, oZip

   cFILE := "file:///"+StrTran(::cPathOut,"\","/")+"/"+::cFileOut+".PDF"
   //Msgstop(Cfile)   // Cfile := "file:///c:/correio/plan_000.pdf"
   oZip := MakeProperty(::oService, "CompressMode", 1)
   oTip := MakeProperty(::oService, "FilterName", "writer_pdf_Export")

   ::oArquivo:storeToURL(cFILE, {oZip,oTip})

return nil

**==============================================================================
METHOD FileOut() CLASS TCalc
**==============================================================================
   local cFile

   cFile := ::cPathOut+"\"+::cFileOut+".ODS"

return cFile


**==============================================================================
STATIC FUNCTION FORMAT_DATA(dSTRDATA)
**==============================================================================
LOCAL cFORMULA

IF VALTYPE(dSTRDATA) != "D" .OR. EMPTY(dSTRDATA)
   RETURN("")
ENDIF

cFORMULA := "=DATE("+STRZERO(YEAR(dSTRDATA),4)+";"
cFORMULA += STRZERO(MONTH(dSTRDATA),2)+";"+STRZERO(DAY(dSTRDATA),2)+")"

RETURN(cFORMULA)

**==============================================================================
STATIC FUNCTION MakeProperty(oServ,cName,nValue)
**==============================================================================
LOCAL oStruct := oServ:Bridge_GetStruct("com.sun.star.beans.PropertyValue")
oStruct:Name  := cName
oStruct:Value := nValue
RETURN(oStruct)
Link to comment
Share on other sites
alex2002 Newbie

alex2002

Posted
Posted

Olá Márcio.

A limitação é 64.512 linhas. Esta limitação é na conexão OLE (imagino eu). Quando fui fazer uma migração por planilha, tive que quebrar.

Como foi uma única vez, fiz sem problema. Agora, para você que todo mês vai ler, vai ter que mudar sim para DBF ou ver a sugestão do amigo JMSILVA e usar o Libre. Eu usaria o Libre e forçava o cliente a instalar (mesmo porque é gratuito).

Link to comment
Share on other sites
marcioe Explorer

marcioe

Posted
  • Author
Posted

Olá amigos

Com csv, ele importa tudo. Fiz assim quando vou importar, crio uma tabela no banco de dados com campos "texto_importar, id", daí dou um load do arquivo csv pra dentro dela, depois leio ela, pegando os dados.

Demora um pouco mais que se fosse em memória, mas como é feito uma vez por mês, leva uns 5 minutos.

Link to comment
Share on other sites
  • 3 years later...
marcioe Explorer

marcioe

Posted
  • Author
Posted

Olá amigos 


Mais uma vez preciso de uma ajuda, estou usando essa rotina, mas está ficando demorando demais para importar os dados, tem casos que leva uns 10 minutos uma planilha com 18.000 registros

Será que tem alguma forma de agilizar.

Agradeço aos amigos

 

Link to comment
Share on other sites
rubensma Newbie

rubensma

Posted
Posted

Olá, boa tarde.

Uso dessa forma para importar planilhas xls, e vai muito bem sem muita demora, se quiser tentar tem dois modelos ai

#include "fivewin.ch"
#include "Fileio.ch"
#include "Inkey.ch"
#define SW_NORMAL   1
#define SW_RESTORE  9


//--------------------------------------------------------------------
// Importar a planilha do excel - cadastro de funcionários
function importacad()

cMod := "ARQUIVOS DE APOIO"
cSer := "Entrada no módulo de importação dos cadastros de funcionários"
registra( cMod , cSer )

MsgMeter( {|oMeter,oText|LerXLScadastro(1,oMeter,oText)}," ", "Importando arquivo do Excel" )

return nil

**************************************************************************
* Montagem de arquivos de apoio - importação do cadastro direto do excel *
**************************************************************************
Function LerXLScadastro(vTot,oMeter,oText)
Local vEsc := .f.  // teste se foi teclado esc
if !msgNoYes("Será importado do Excel o arquivo cadastro de funcionários!"+;
             chr(13)+chr(13)+"Deseja continuar?","..: Atenção :..")
   Return nil 
Endif
cArq1 := cGetFile32("cadast*.X*","Escolha o arquivo a importar")
If !File(cArq1) .or. ! "cadastro" $ cArq1
   msginfo("Arquivo inválido ou não disponível."+chr(13)+;
            "Verifique o nome do arquivo !","Informação")
   Return nil 
Endif   
oExcel:=TOleAuto():New("Excel.Application")
oBook := oExcel:Workbooks:Open(cArq1)
oHoja := oExcel:Get( "ActiveSheet" )
nTotRowCount := oHoja:UsedRange:Rows:Count()  // TOTAL DE LINHAS DO ARQUIVO
dbSelectArea( "cad" )    // zerar o arquivo base
cad->( dbzap() )         // arquivo foi aberto com uso exclusivo 
oMeter:nTotal := nTotRowCount - 2  // descontar o cabeçalho 
nCount := 0
FOR Q = 3 TO nTotRowCount   // começa na linha 
     cad->( dbAppend() )
    cad->( rlock() )
    cad->filial    := iif(oHoja:Cells( Q, 1 ):Value == nil,"",oHoja:Cells( Q, 1 ):Value)
    cad->matricula := iif(oHoja:Cells( Q, 2 ):Value == nil,0,oHoja:Cells( Q, 2 ):Value)
    cad->nome      := iif(oHoja:Cells( Q, 3 ):Value == nil,"",oHoja:Cells( Q, 3 ):Value)
    cad->datadm    := iif(oHoja:Cells( Q, 4 ):Value == nil,ctod("  /  /  "),oHoja:Cells( Q, 4 ):Value) //oHoja:Cells( Q,  4 ):Value
    cad->situacao  := iif(oHoja:Cells( Q, 5 ):Value == nil,"",oHoja:Cells( Q, 5 ):Value)
    cad->ccusto    := iif(oHoja:Cells( Q, 6 ):Value == nil,"",oHoja:Cells( Q, 6 ):Value)
    cad->tipo      := iif(oHoja:Cells( Q, 7 ):Value == nil,"",oHoja:Cells( Q, 7 ):Value)
    cad->gerencia  := iif(oHoja:Cells( Q, 8 ):Value == nil,"",oHoja:Cells( Q, 8 ):Value)
    cad->area      := iif(oHoja:Cells( Q, 9 ):Value == nil,"",oHoja:Cells( Q, 9 ):Value)
    cad->(Dbunlock() )   
     oMeter:Set(++nCount)
     oText:SetText("Importando cadastro de funcionários!"+chr(13)+;
                     "Processando Registro : "+str(nCount,6)+"/"+str(oMeter:nTotal,6) )            
    if lastkey() = 27
       vEsc := .t.
       exit
    endif
NEXT
oExcel:WorkBooks:Close()
oExcel:Application:Quit()
RELEASE oHoja
RELEASE oExcel
if vEsc  
   msginfo("Importação interrompida pelo usuário")
else    
   msginfo("Arquivo importado com sucesso!")
endif   
cad->( dbGoTop() )
browse()
Return nil

Outro, com campos numéricos


***************************************************************************
* Montagem de arquivos de apoio - importação da tabela de código do excel *
***************************************************************************
Function LerXLStabela(vTot,oMeter,oText)
Local vEsc := .f.  // teste se foi teclado esc
if ! msgNoYes("Será importado do Excel o arquivo tabela de códigos!"+;
             chr(13)+chr(13)+"Deseja continuar?","..: Atenção :..")
   Return nil 
Endif
cArq2 := cGetFile32("Tabela de códigos|Tabe*.XL*|","Escolha o arquivo a importar")
If ! File(cArq2) .or. ! "Tabela" $ cArq2
   msginfo("Arquivo inválido ou não disponível."+chr(13)+;
            "Tente novamente !","Informação")
   Return nil 
Endif   
oExcel:=TOleAuto():New("Excel.Application")
oBook := oExcel:Workbooks:Open(cArq2)
oHoja := oExcel:Get( "ActiveSheet" )
nTotRowCount := oHoja:UsedRange:Rows:Count()  // TOTAL DE LINHAS DO ARQUIVO
dbSelectArea( "tab" )    // zerar o arquivo base
tab->( dbzap() )         // arquivo foi aberto com uso exclusivo 
oMeter:nTotal := nTotRowCount - 1  // descontar o cabeçalho 
*::: Formato de Columnas
//oHoja:Columns( 22 ):Set("NumberFormat","@") // formatar a coluna para texto
//oHoja:Columns( 23 ):Set("NumberFormat","@") // formatar a coluna para texto
nCount := 0
FOR Q = 2 TO nTotRowCount   // começa na linha 
     tab->( dbAppend() )
    tab->( rlock() )
    tab->cod  := iif(oHoja:Cells( Q, 1 ):Value == nil, 0,oHoja:Cells( Q,  1 ):Value)
    tab->desc := iif(oHoja:Cells( Q, 2 ):Value == nil,"",oHoja:Cells( Q,  2 ):Value)
    tab->in   := iif(oHoja:Cells( Q, 3 ):Value == nil,"",oHoja:Cells( Q,  3 ):Value)
    tab->ir   := iif(oHoja:Cells( Q, 4 ):Value == nil,"",oHoja:Cells( Q,  4 ):Value) 
    tab->fg   := iif(oHoja:Cells( Q, 5 ):Value == nil,"",oHoja:Cells( Q,  5 ):Value) 
    tab->br   := iif(oHoja:Cells( Q, 6 ):Value == nil,"",oHoja:Cells( Q,  6 ):Value)
    tab->de   := iif(oHoja:Cells( Q, 7 ):Value == nil,"",oHoja:Cells( Q,  7 ):Value) 
    tab->lq   := iif(oHoja:Cells( Q, 8 ):Value == nil,"",oHoja:Cells( Q,  8 ):Value) 
    tab->es   := iif(oHoja:Cells( Q, 9 ):Value == nil,"",oHoja:Cells( Q,  9 ):Value)
    tab->dp   := iif(oHoja:Cells( Q,10 ):Value == nil,"",oHoja:Cells( Q, 10 ):Value)
    tab->ra   := iif(oHoja:Cells( Q,11 ):Value == nil, 0,oHoja:Cells( Q, 11 ):Value)
    tab->un   := iif(oHoja:Cells( Q,12 ):Value == nil,"",oHoja:Cells( Q, 12 ):Value)
    tab->di   := iif(oHoja:Cells( Q,13 ):Value == nil,"",oHoja:Cells( Q, 13 ):Value)
    tab->vig  := iif(oHoja:Cells( Q,14 ):Value == nil,"",oHoja:Cells( Q, 14 ):Value)
    tab->un1  := iif(oHoja:Cells( Q,15 ):Value == nil,"",oHoja:Cells( Q, 15 ):Value)
    tab->un2  := iif(oHoja:Cells( Q,16 ):Value == nil,"",oHoja:Cells( Q, 16 ):Value)
    tab->fx   := iif(oHoja:Cells( Q,17 ):Value == nil,"",oHoja:Cells( Q, 17 ):Value) 
    tab->val_ := iif(oHoja:Cells( Q,18 ):Value == nil,"",oHoja:Cells( Q, 18 ):Value) 
    tab->dup  := iif(oHoja:Cells( Q,19 ):Value == nil,"",oHoja:Cells( Q, 19 ):Value)
    tab->rend := iif(oHoja:Cells( Q,20 ):Value == nil, 0,oHoja:Cells( Q, 20 ):Value)
    tab->t1   := iif(oHoja:Cells( Q,21 ):Value == nil, 0,oHoja:Cells( Q, 21 ):Value)
    tab->cont := iif(oHoja:Cells( Q,22 ):Value == nil, 0,oHoja:Cells( Q, 22 ):Value)
    tab->t2   := iif(oHoja:Cells( Q,23 ):Value == nil, 0,oHoja:Cells( Q, 23 ):Value)
    if ValType( oHoja:Cells( Q,24 ):Value ) = "N"  // se for campo numérico
       tab->deb  := iif(oHoja:Cells( Q,24 ):Value == nil,0,str(oHoja:Cells( Q, 24 ):Value))
    else
        tab->deb  := iif(oHoja:Cells( Q,24 ):Value == nil,"",oHoja:Cells( Q, 24 ):Value)
    endif
     if ValType( oHoja:Cells( Q,25 ):Value ) = "N"  // se for campo numérico   
       tab->cre  := iif(oHoja:Cells( Q,25 ):Value == nil,0,str(oHoja:Cells( Q, 25 ):Value))
    else   
       tab->cre  := iif(oHoja:Cells( Q,25 ):Value == nil,"",oHoja:Cells( Q, 25 ):Value)
    endif   
    tab->dg   := iif(oHoja:Cells( Q,26 ):Value == nil, 0,oHoja:Cells( Q, 26 ):Value)
    tab->(Dbunlock() )   
     oMeter:Set(++nCount)
     oText:SetText("Importando tabela de códigos!"+chr(13)+;
                     "Processando Registro : "+str(nCount,6)+"/"+str(oMeter:nTotal,6) )            
    if lastkey() = 27
       vEsc := .t.
       exit
    endif
NEXT

oExcel:WorkBooks:Close()
oExcel:Application:Quit()
RELEASE oHoja
RELEASE oExcel
if vEsc  
   msginfo("Importação interrompida pelo usuário")
else    
   msginfo("Arquivo importado com sucesso!")
endif   
tab->( dbGoTop() )
//browse()
Return nil

 

 

Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

Loading...
×
 Share
Go to topic listing
×
×
  • Create New...