Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Dbf2rs
Message
From
10/09/2010 05:15:22
Jon Neale
Bond International Software
Wootton Bassett, United Kingdom
 
 
To
All
General information
Forum:
Visual FoxPro
Category:
Coding, syntax & commands
Title:
Dbf2rs
Environment versions
Visual FoxPro:
VFP 6 SP5
OS:
Windows XP SP2
Network:
Windows 2003 Server
Database:
Visual FoxPro
Application:
Desktop
Miscellaneous
Thread ID:
01480753
Message ID:
01480753
Views:
158
Hi All,

I have implemented Cetin Basoz's export to excel functionality and it has been working very well. However I have noticed something and was hoping for some feedback, the issue is actually with Dbf2rs not the additional code kindly posted by Cetin. When I export a numeric value it changes the decimals, so for example if I export 11000.03 it changes it in excel to 11000.0302734373. I believe the issue to be with the recordset not excel as I can see the value has changed when its entered into the recordset. The type for the field in the rs is ADSINGLE.

Is there anyway I can prevent this or improve the way this works?

Many Thanks

Jon
*** 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
Next
Reply
Map
View

Click here to load this message in the networking platform