* This routine copies a cursor to an Excel spreasheet using ADODB. Field names may be long. PROCEDURE Cursor2Excel LPARAMETERS tuWorkbook,tcWorksheetName,tcOpciones * tuWorkbook: Always refers to a workbook, either by a file name or by reference to an object already in memory. * Empty -> Creates a new workbook without saving it * Character -> It is the name of an xls file, open or not * Workbook -> Object in memory * tcWorksheetName: If empty use default name * tcOpciones: Can contain 'ADDITIVE' and/or 'SAVE' tuWorkbook = IIF(EMPTY(tuWorkbook),'',IIF(VARTYPE(tuWorkbook)='C',FORCEEXT(tuWorkbook,'xls'),tuWorkbook)) && Puede ser .F. tcWorksheetName = IIF(EMPTY(tcWorksheetName),'',tcWorksheetName) tcOpciones = IIF(EMPTY(tcOpciones),'',UPPER(tcOpciones)) && Puede ser .F. * Since it is slow to eliminate a table from a DBC we create a DBC in a temporary diectory which is deleted at the end LOCAL lnSelect,lcTempDBC,lcTempTable,lcXLSFile lnSelect = SELECT() lcTempDir = 'C:\Temp\' + SYS(2015) + '\' lcTempDBC = lcTempDir + 'MyDatabase.dbc' lcTempTable = lcTempDir + 'MyTable.dbf' MD (lcTempDir) CREATE DATABASE (lcTempDBC) COPY TO (lcTempTable) DATABASE (lcTempDBC) NAME MyTable CLOSE DATABASES SELECT (lnSelect) * Code by Cetin Local loRS as AdoDB.Recordset,loRS2 as AdoDB.Recordset,loCon as AdoDB.Connection LOCAL loExcel AS Excel.Application,loWorkbook,loSheet loCon = CreateObject('ADODB.connection') loCon.ConnectionString = "Provider=VFPOLEDB;Data Source="+lcTempDBC loCon.Open() loRS = loCon.Execute('SELECT * FROM myTable') llUsarDisconnectMe = .F. IF llUsarDisconnectMe IF FILE('disconnectme.rst') ERASE disconnectme.rst ENDIF loRs.Save('disconnectme.rst') loRS2 = CreateObject('ADODB.Recordset') loRs2.Open('disconnectme.rst') ELSE ENDIF * Take it to Excel IF TYPE('tuWorkbook') = 'C' && We assume tuWorkbook is the name of a file, whether it exists or not * Open Excel loExcel = Createobject('Excel.Application') loExcel.WindowState = -4137 && xlMaximized * Erase previous copy from disk if adding a sheet was not requested llBorrarOK = .T. IF NOT EMPTY(tuWorkbook) AND NOT 'ADDITIVE' $ tcOpciones AND FILE(tuWorkbook) * Use TRY/CATCH because file may be in use TRY ERASE (tuWorkbook) CATCH * Since we couldn't erase tile leave new workbook open without saving WAIT WINDOW NOWAIT 'Could not erase previous copy of ' + tuWorkbook llBorrarOK = .F. ENDTRY ENDIF * Create new file or open previous on ADDITIVE option llAbrirAnteriorOk = .F. llAbrirNuevoOK = .F. IF 'ADDITIVE' $ tcOpciones TRY loExcel.Workbooks.Open(tuWorkbook) llAbrirAnteriorOK = .T. CATCH llAbrirNuevoOK = .F. ENDTRY IF llAbrirAnteriorOK * Add a page at the end WITH loExcel.ActiveWorkbook.Worksheets .Add(.NULL.,.Item(.Count)) ENDWITH ELSE * If cannot open workbook create a new one creamos uno nuevo TRY loExcel.Workbooks.Add() llAbrirNuevoOK = .T. CATCH ENDTRY ENDIF ELSE TRY loExcel.Workbooks.Add() CATCH llAbrirNuevoOK = .T. ENDTRY ENDIF * Reference to workbook loWorkbook = loExcel.ActiveWorkbook * Reference worksheet that receives data loSheet = loWorkbook.ActiveSheet * Bring data in IF llUsarDisconnectMe loSheet.QueryTables.Add( loRS2, loExcel.Range("A1")).Refresh ELSE WITH loSheet FOR ix=1 TO loRS.Fields.Count .Cells(1,m.ix).Value = PROPER(loRs.Fields(m.ix-1).Name) ENDFOR .Range('A2').CopyFromRecordSet( loRS ) ENDWITH ENDIF loExcel.Visible = .T. * Name worksheet if requested. If name exists add 1,2,3 until 9 IF !EMPTY(tcWorksheetName) FOR i = 0 TO 9 lcNumero = IIF(i=0,'',TRANSFORM(i)) TRY loSheet.Name = lcSheetName + lcNumero llOK = .T. CATCH llOK = .F. ENDTRY IF llOK EXIT ENDIF ENDFOR ENDIF * Save if appropriate IF !EMPTY(tuWorkbook) IF FILE(tuWorkbook) loWorkbook.Save() ELSE loWorkbook.SaveAs(tuWorkbook) ENDIF ENDIF ELSE * Asume tuWorkbook objeto-workbook ENDIF * Cleanup loRS.Close() IF llUsarDisconnectMe loRS2.Close() ENDIF loCon.Close() ERASE 'disconnectme.rst' ERASE (ADDBS(lcTempDir)+'*.*') RD (lcTempDir) RETURN loExcel