Manejando el portapapeles y Excel he trabajado m谩s de 10mil registros en unos cuantos segundos usando la clase TExcel.
La soluci贸n a tu problema es muy sencillo, te anexo el m茅todo que modifique a la clase TSbrowse en su versi贸n 7 donde puedes hacer la migraci贸n de una tabla completa a Excel sin importar el n煤mero de registro que tenga.
* ============================================================================
* METHOD TSBrowse:ExcelOle() Version 7.0 Jul/15/2004
* Requires TOleAuto class
* Many thanks to Victor Manuel Tom谩s ( Vikthor ) for the core of this method
* ============================================================================
METHOD ExcelOle( cXlsFile, lActivate, oMeter, cTitle, ;
oFont, lSave ) CLASS TSBrowse
Local oExcel, oBook, oSheet, nRow, nCol, uData, nEvery, oRange, cRange, cCell, ;
bError, cText, oClip, nStart, ;
nLine := 1, ;
nCount := 0, ;
nRecNo := ( ::cAlias )->( RecNo() ), ;
nAt := ::nAt
Default lActivate := Empty( cXlsFile ), ;
cTitle := "", ;
lSave := .F.
CursorWait()
::lNoPaint := .F.
If oMeter != Nil
oMeter:nTotal := ( ::nLen + 1 ) * Len( ::aColumns ) + 30
oMeter:Set( 0 )
oMeter:Refresh()
nEvery := Max( 1, Int( oMeter:nTotal * .02 ) ) // refresh ometer every 2 %
EndIf
cXlsFile := AllTrim( StrTran( Upper( cXlsFile ), ".XLS" ) )
cTitle := AllTrim( cTitle )
* bError := ErrorBlock( { | x | Break( x ) } )
TRY
oExcel := GetActiveObject( "Excel.Application" )
oWord := GetActiveObject( "Word.Application" )
CATCH
TRY
oExcel := CreateObject( "Excel.Application" )
oWord := CreateObject( "Word.Application" )
CATCH
Alert( "ERROR! Excel no est谩 instaldo en esta PC. " )
END
END
/*
Begin Sequence
oExcel := TOleAuto():New("Excel.Application")
Recover
ErrorBlock( bError )
CursorArrow()
MsgStop( "No Ole.lib searched", "Error" )
Return Nil
End Sequence
ErrorBlock( bError )
*/
If oMeter != Nil
nCount -= 15
oMeter:Set( nCount )
EndIf
oExcel:WorkBooks:Add()
oBook := oExcel:Get( "ActiveWorkBook")
oSheet := oExcel:Get( "ActiveSheet" )
oDocs := oWord:Get( "Documents")
oDocs:Invoke( "Add" )
oActiveDoc := oWord:Get("ActiveDocument")
If oMeter != Nil
nCount -= 15
oMeter:Set( nCount )
EndIf
( ::cAlias )->( Eval( ::bGoTop ) )
cText := ""
For nRow := 1 To ::nLen
If nRow == 1
If ! Empty( cTitle )
oSheet:Cells( nLine++, 1 ):Value := AllTrim( cTitle )
oSheet:Range( "A1:" + Chr( 64 + Len( ::aColumns ) ) + ;
"1" ):Set( "HorizontalAlignment", 7 )
++nLine
nStart := nLine
Else
nStart := 1
EndIf
For nCol := 1 To Len( ::aColumns )
uData := If( ValType( ::aColumns[ nCol ]:cHeading ) == "B", ;
Eval( ::aColumns[ nCol ]:cHeading ), ;
::aColumns[ nCol ]:cHeading )
If ValType( uData ) != "C"
Loop
EndIf
uData := StrTran( uData, CRLF, Chr( 10 ) )
cText += uData + Chr( 9 )
If oMeter != Nil
If nCount % nEvery == 0
oMeter:Set( nCount )
EndIf
nCount ++
EndIf
Next
cText += Chr( 13 )
EndIf
For nCol := 1 To Len( ::aColumns )
If ::aColumns[ nCol ]:lBitMap
Loop
EndIf
uData := Eval( ::aColumns[ nCol ]:bData )
If ValType( uData ) == "C"
uData := StrTran( uData, CRLF, Chr( 10 ) )
EndIf
If ::aColumns[ nCol ]:cPicture != Nil
uData := Transform( uData, ::aColumns[ nCol ]:cPicture )
EndIf
uData := IIF( ValType( uData )=="D", DtoC( uData ), ;
IIF( ValType( uData )=="N", Str( uData ) , ;
IIF( ValType( uData )=="L", IIF( uData ,".T." ,".F." ), uData ) ) )
cText+=alltrim( uData ) + Chr( 9 )
If oMeter != Nil
If nCount % nEvery == 0
oMeter:Set( nCount )
EndIf
nCount ++
EndIf
Next
::Skip( 1 )
cText += Chr( 13 )
++nLine
/*
Cada 20k volcamos el texto a la hoja de Excel , usando el portapapeles , algo muy rapido y facil ;-)
Every 20k set text into excel sheet , using Clipboard , very easy and faster.
*/
IF Len( cText ) > 20000
oClip := TClipBoard():New()
oClip:Clear()
oClip:SetText( cText )
cCell := "A" + Alltrim( Str( nStart ) )
oRange := oSheet:Range( cCell )
oRange:Select()
oSheet:Paste()
oTexto := oActiveDoc:Range()
oTables := oActiveDoc:Get( "Tables")
nRows:=250
nCols:=40
oTexto:SetRange( 1 , 1 )
oTable:= oTables:Invoke("Add", oTexto , nRows , nCols )
* oTable:Paste()
oClip:End()
cText := ""
nStart := nLine + 1
EndIf
Next
If ::lIsDbf
( ::cAlias )->( DbGoTo( nRecNo ) )
EndIf
::nAt := nAt
If Len( cText ) > 0
oClip := TClipBoard():New()
oClip:Clear()
oClip:SetText( cText )
cCell := "A" + Alltrim( Str( nStart ) )
oRange := oSheet:Range( cCell )
oRange:Select()
oSheet:Paste()
oClip:End()
cText := ""
EndIf
cRange := "A3:" + Chr( 64 + Len( ::aColumns ) ) + ;
Alltrim( Str( oSheet:UsedRange:Rows:Count() ) )
oRange := oSheet:Range( cRange )
If oFont != Nil // let the programmer to decide the font he wants, otherwise use Excel's default
oRange:Font:Name := oFont:cFaceName
oRange:Font:Size := oFont:nSize()
oRange:Font:Bold := oFont:lBold
EndIf
oRange:Borders():LineStyle := 1
oRange:Columns:AutoFit()
If oMeter != Nil
oMeter:Set( oMeter:nTotal )
EndIf
If cXlsFile != Nil .and. lSave
oBook:SaveAs( cXlsFile, -4143 ) // -4143 = Normal
EndIf
oSheet:Range( "A1" ):Select()
CursorArrow()
If lActivate
oExcel:Visible := .T.
oWord:Visible := .T.
EndIf
OleUninitialize()
Return Nil
