*** Original author: Cetin Basoz *** Modified by JN 09/02/2010 * added as part of ES1084 PROCEDURE VFP2Excel LPARAMETERS tcCursorName, toRange IF EMPTY(tcCursorName) RETURN ENDIF lcTemp = FORCEPATH(SYS(2015) + '.dbf',SYS(2023)) SELECT (m.tcCursorName) COPY TO (m.lcTemp) loRS = DBF2RS(tcCursorName) toRange.Offset(1,0).CopyFromRecordSet(loRS) && Copy data starting from headerrow + 1 FOR ix=1 TO loRS.FIELDS.COUNT * JN - 09/02/2010 - to deal with Cross Tab reports IF xfv_xtab =AFIELDS(w_tcCursorName,tcCursorName) toRange.Offset(0,m.ix-1).VALUE = PROPER(ALLTRIM(w_tcCursorName[ix,1])) ELSE toRange.Offset(0,m.ix-1).VALUE = xfv_headin[ix] ENDIF toRange.Offset(0,m.ix-1).FONT.Bold = .T. ENDFOR loRS.CLOSE ERASE (m.lcTemp) RETURN * * * FUNCTION DBF2RS * added as part of ES1084 LPARAMETERS tcTable,tcScope,tlAddRecNoColumn,tlAddVariantColumn #INCLUDE "adovfp.h" #INCLUDE "dbf2rs.h" LOCAL lcTable,lcAlias,lcScope,lcDBF,lnDataTypeEnum,rs LOCAL lvValue,lnFieldCount,lcField,lcFieldType,lnFieldSize,lnFieldAttributes LOCAL lnItemCount,lnCount,lnMatchCount,lnLastSelect,lnLastRecNo DIMENSION laFields[1],laItems[1],laValues[1] IF NOT INLIST(VARTYPE(tcTable),"C","L") OR NOT INLIST(VARTYPE(tcScope),"C","L") RETURN .NULL. ENDIF lcTable=LOWER(IIF(EMPTY(tcTable),ALIAS(),ALLTRIM(tcTable))) lnLastSelect=SELECT() IF "."$lcTable lcDBF=lcTable IF NOT FILE(lcDBF) RETURN .NULL. ENDIF SELECT 0 lcAlias=LOWER(SYS(2015)) USE (lcDBF) ALIAS (lcAlias) AGAIN SHARED ELSE lcDBF="" lcAlias=lcTable ENDIF IF NOT USED(lcAlias) SELECT (lnLastSelect) RETURN .NULL. ENDIF rs=NEWOBJECT("ADODB.Recordset") IF VARTYPE(rs)#"O" RETURN .NULL. ENDIF lcScope=IIF(EMPTY(tcScope),"ALL",ALLTRIM(tcScope)) SELECT (lcAlias) lnLastRecNo=IIF(EOF(),0,RECNO()) rs.cursorLocation=ADUSECLIENT rs.cursorType=ADOPENSTATIC rs.lockType=ADLOCKOPTIMISTIC lnFieldCount=AFIELDS(laFields) lnItemCount=0 IF tlAddRecNoColumn lcField=F_RECNO_FIELD lnItemCount=1 laItems[1]=lcField rs.fields.append(lcField,ADINTEGER,8) ENDIF FOR lnCount = 1 TO lnFieldCount lcField=laFields[lnCount,1] lcFieldType=laFields[lnCount,2] IF lcFieldType=="G" LOOP ENDIF lnFieldSize=laFields[lnCount,3] lnFieldAttributes=ADFLDFIXED+ADFLDUPDATABLE IF laFields[lnCount,5] lnFieldAttributes=lnFieldAttributes+ADFLDISNULLABLE ENDIF DO CASE CASE lcFieldType=="C" lnDataTypeEnum=ADCHAR CASE lcFieldType=="M" lnDataTypeEnum=ADCHAR lnFieldSize=256 CASE lcFieldType=="L" lnDataTypeEnum=ADBOOLEAN CASE lcFieldType=="D" lnDataTypeEnum=ADDBDATE CASE lcFieldType=="T" lnDataTypeEnum=ADDBTIMESTAMP lnFieldSize=6 CASE lcFieldType=="N" lnDataTypeEnum=ADSINGLE && Numeric value goes here and creates a type of ADSINGLE CASE lcFieldType=="B" lnDataTypeEnum=ADDOUBLE CASE lcFieldType=="I" lnDataTypeEnum=ADINTEGER CASE lcFieldType=="F" lnDataTypeEnum=ADDOUBLE CASE lcFieldType=="Y" lnDataTypeEnum=ADCURRENCY OTHERWISE LOOP ENDCASE lnItemCount=lnItemCount+1 DIMENSION laItems[lnItemCount] laItems[lnItemCount]=lcField rs.fields.append(lcField,lnDataTypeEnum,lnFieldSize,lnFieldAttributes) ENDFOR IF tlAddVariantColumn lcField=F_VARIANT_FIELD lnItemCount=lnItemCount+1 DIMENSION laItems[lnItemCount] laItems[lnItemCount]=lcField rs.fields.append(lcField,ADVARIANT,1) ENDIF IF lnItemCount<=1 RETURN .NULL. ENDIF DIMENSION laValues[lnItemCount] rs.open lnMatchCount=0 SCAN &lcScope lnMatchCount=lnMatchCount+1 laValues[1]=RECNO() FOR lnCount = IIF(tlAddRecNoColumn,2,1) TO (lnItemCount-IIF(tlAddVariantColumn,1,0)) lvValue=EVALUATE(laItems[lnCount]) DO CASE CASE VARTYPE(lvValue)=="T" AND EMPTY(lvValue) lvValue={^1980/01/01 12:00:00 AM} CASE VARTYPE(lvValue)=="D" AND EMPTY(lvValue) lvValue={^1980/01/01} ENDCASE laValues[lnCount]=lvValue ENDFOR IF tlAddVariantColumn laValues[lnItemCount]="" ENDIF rs.addNew(@laItems,@laValues) ENDSCAN IF lnMatchCount>0 rs.moveFirst ENDIF IF EMPTY(lcDBF) IF lnLastRecNo>0 GO lnLastRecNo ENDIF ELSE USE ENDIF SELECT (lnLastSelect) RETURN rs