Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
Quick Transfer of Losts of VFP Data to Word Table?
Message
From
12/10/2001 15:09:16
 
 
To
12/10/2001 11:17:41
Isabel Cabanne
Hubbard Woods Software, Inc.
Winnetka, Illinois, United States
General information
Forum:
Visual FoxPro
Category:
COM/DCOM and OLE Automation
Miscellaneous
Thread ID:
00567281
Message ID:
00567894
Views:
22
>>Word, Excel and Powerpoint now use HTML as a "native" file format. MS' approach is to incorporate some header information in XML and CSS in a format they call Office HTML.
>
>>Simply generate an HTML document in VFP, then open that in Word. It's orders of magnitude faster than OLE automation.
>
>>I have some code to generate an HTML table from a cursor and can share that if you're interested.
>
>
>Jay,
>
>Yes, I'm interested. Moving through HTML would also open the opportunity of letting the user have the data as HTML. I'd like to se the code.
>
>Thanks,
>Isabel

Isabel --

I rewrote this to avoid HTML tags in the code -- so some of the defines and variables will look a little funny. The UT, for self-preservation, doesn't allow a number of tags to be embedded in messages. If you want, you can just join the concatenated expression into a single string literal for better readability on your end. I did a test run after the mods, but haven't gone through all permutations, so please keep that in mind in your use.

There is a file in the library -- DBFtoHTML -- which offers some of the same functionality. The benefit of that routine is the handling of various letters used in European alphabets with length indicators.

My target output for this is Word. I generate the HTM doc then open in Word and reformat the table for my purposes. So, table formatting is at a minimum and may not be optimal for your use. It would be straightforward to add HTML formatting tags for the table or table cells to customize for your purposes.

Enjoy!

Jay
*	TableToHTML.PRG

*	This is a simple program which writes a table to HTML.
*	The value of this is that it's suddenly much easier to send to someone
*	or to incorporate into a Word doc.

*	It provides significantly more flexibility than generating to Excel, in that:
*	It can be incorporated as a native Word table rather than an embedded spreadsheet.
*	The caller has the options of including header information or not and, with 
*	user generated column headers, of providing other columns which will be filled in
*	manually.

*	9/6/2001	JvS

*	PARAMETER				IN/OUT		OPT/REQ		PURPOSE
*		tcHTMLOutputFile	IN			REQ			(path) and name of HTML output file
*		txWorkArea			IN			OPT			Numeric work area or alias
*													If unspecified, current work area is used.
*		tcHTMLHeader		IN			OPT			Used to describe in HTML header 
*													the file generated.
*		tlUseColumnHeaders	IN			OPT			If .F. no table column headers are
*														generated.
*													If .T. and txColumnHeaders is not
*														empty, those are used for headers.
*													If .T. and txColumnHeaders is empty,
*														the field names are used.
*		txColumnHeaders		IN			OPT			If not empty and tlUseColumnHeaders is
*														.T., table column headers are generated.
*														Format is a comma delimited list.
*		tlWarnOverwrite		IN			OPT			Default = .F.
*														Whether to warn the user when
*														overwriting a file.
*		tcNotOKMessage		IN/OUT		OPT			If passed as a parameter with a character value.
*														this routine passes back the value.
*														PASS BY REFERENCE in calling routine.
*													Otherwise (if not passed, or passed
*														as a non-character), this routine
*														reports the error.
*													
*	Invocations
*	1.	Simplest invocation
*		DO d:\utilities\TabletoHTML.prg WITH 'testhtml.htm'
*			This outputs only the data from the currently selected work area
*			to a file named 'testhtml.htm' in the current directory.
*	2.	DO d:\utilities\TabletoHTML.prg WITH 'testhtml.htm', 1
*			This does the same as 1, except it selects the 1st work area.
*	3.	DO d:\utilities\TabletoHTML.prg WITH 'testhtml.htm', 'ACursor'
*			This does the same as 1, except it selects the work area with ACursor.
*	4.	DO d:\utilities\TabletoHTML.prg WITH 'testhtml.htm', 1, .T.
*			This does the same as 2, except it outputs the field names in the table column headers.
*	5.	DO d:\utilities\TabletoHTML.prg WITH 'testhtml.htm', 1, .T.
*			This does the same as 2, except it outputs the field names in the table column headers.
*	6.	DO d:\utilities\TabletoHTML.prg WITH 'testhtml.htm', 1, .T., .F., 'First,Second,Third,Fourth'
*			This does the same as 2, except it outputs caller-provided names for the column headers.
*	7.	DO d:\utilities\TabletoHTML.prg WITH 'testhtml.htm', 1, .T., .F., 'First,Second,Third,Fourth, Fifth'
*			This does the same as 5, except it outputs the caller-provided names for the column headers
*			and adds one column beyond the number of fields.
*	8.	DO d:\utilities\TabletoHTML.prg WITH 'testhtml.htm', 1, .T., .F., 'First,Second'
*			This does the same as 5, except it outputs the caller-provided column headers and outputs
*			only 2 fields.
*	9.	DO d:\utilities\TabletoHTML.prg WITH 'testhtml.htm', 1, .T., .F., 'First,Second', .T.
*			This does the same as 8, except it warns the user they are about to overwrite a file.


LPARAMETER		tcHTMLOutputFile, txWorkArea, tcHTMLHeader, tlUseColumnHeaders,  ;
				txColumnHeaders, tlWarnOverwrite, tcNotOKMessage
LOCAL			lcOldPath, llDeletedWasOff, lcSafety, llSafetyWasOn
LOCAL			lcNotOKMessage, lcHTMLOutputFile, llReportHere, lcWorkAreaType, lnWorkArea
LOCAL			lnOldWorkArea
LOCAL			lxColumnHeaders, lnHeaders, lcColumns, laHeaders
LOCAL			lcHTMLOutputFile, lcProjectPathName
LOCAL			lcHTMLStart, lcHTMLEnd, lcTableStart, lcTableEnd, lcRowStart
LOCAL			lcRowEnd, lcCellStart, lcCellEnd, lcHeaderCells, lnLinesWritten

DIMENSION		laHeaders[1]

#DEFINE		EOL								CHR(13)
#DEFINE		HARD_SPACE						'&nbsp'
#DEFINE		HTML_BEGIN						'<' + 'html>'
#DEFINE		HTML_END						'</' + 'html>'
#DEFINE		HTML_HEADER  					'<' + 'head>' + '</' + 'head>'
#DEFINE		HTML_BODY_BEGIN					'<' + 'body>'
#DEFINE		HTML_BODY_END					'</' + 'body>'
#DEFINE		HTML_TABLE_BEGIN				'<' + 'table>'
#DEFINE		HTML_TABLE_END					'</' + 'table>'
#DEFINE		HTML_BREAK						'<' + 'br>'
#DEFINE		HTML_TABLE_HEADER_CELL_BEGIN	'<' + 'th>'
#DEFINE		HTML_TABLE_HEADER_CELL_END		'</' + 'th>' 


	*	Setup environment
	
	llReportHere = (TYPE ('tcNotOKMessage') = 'L')
	tcNotOKMessage = ''
	
	lcOldPath = SET ('PATH')
	SET PATH TO 

	llDeletedWasOff = (SET ('DELETED') = 'OFF')
	IF llDeletedWasOff
		SET DELETED ON
	ENDIF
	
	llSafetyWasOn = (SET ('SAFETY') = 'ON')
	IF llSafetyWasOn <> tlWarnOverwrite			&&	Test if safety setting is incorrect.
		lcSafety = IIF (llSafetyWasOn, 'OFF', 'ON')
		SET SAFETY &lcSafety
	ELSE
		lcSafety = ''
	ENDIF
	
	lnOldWorkArea = SELECT (0)
	
	*	Test parameters
		
	IF TYPE ('tcHTMLOutputFile') <> 'C'
		tcNotOKMessage = 'tcHTMLOutputFile not a string.'
	ENDIF
	IF EMPTY (tcNotOKMessage)
		lcJustPath = JustPath (tcHTMLOutputFile)
		IF NOT EMPTY (lcJustPath) and NOT DIRECTORY(lcJustPath)		&&	Allow current directory
			lcHTMLOutputFile = GetFile('HTM', 'Please choose an HTML output file in an existing directory.')
			IF EMPTY (lcHTMLOutputFile)
				tcNotOKMessage = 'No HTML output file chosen in an existing directory.'
			ENDIF
		ELSE
			lcHTMLOutputFile = ALLTRIM (tcHTMLOutputFile)
		ENDIF
	ENDIF
	
	*	Continue validating parameters and transform them internal use.
	
	IF EMPTY (tcNotOKMessage)
		*	Put appropriate extension on, if needed.
		IF RIGHT (UPPER (lcHTMLOutputFile), 4) <> '.HTM'
			lcHTMLOutputFile = lcHTMLOutputFile + '.HTM'
		ENDIF 
	
		*	Convert work area to proper format for our use.
		lcWorkAreaType = TYPE ('txWorkArea')
		DO CASE
			CASE	NOT INLIST (lcWorkAreaType, 'C', 'N')
				lnWorkArea = SELECT (0)
			CASE	lcWorkAreaType = 'C'
				IF USED (txWorkArea)
					lnWorkArea = SELECT (txWorkArea)
				ELSE
					tcNotOKMessage = 'Source table is not open.'
				ENDIF
				
			CASE	lcWorkAreaType = 'N'
				IF BETWEEN (txWorkArea, 1, 32767)
					lnWorkArea = txWorkArea
				ELSE
					tcNotOKMessage = 'Work area is out of range.'
				ENDIF
		ENDCASE	
	ENDIF
	
	IF EMPTY (tcNotOKMessage)
		IF EMPTY (tcHTMLHeader)
			lcHTMLHeader = 'Output of a table or cursor ' + ALIAS() ;
				+ '. Created: ' + TRANSFORM(DATETIME())
		ELSE
			lcHTMLHeader = tcHTMLHeader
		ENDIF
		
		SELECT (lnWorkArea)
		IF NOT USED ()		&&	Test that a table is open in work area.
			tcNotOKMessage = 'No table is open in selected work area.'
		ENDIF
	ENDIF
	
	IF EMPTY (tcNotOKMessage)

		lnFields = AFIELDS (laFields)		&&	Get field info for variety of purposes

		*	Co-ordinate Column header information provided by call with
		*	fields available. Determine the number of columns to show:
		*	If there are no user provided column headers, output all fields.
		*	If there are user-provided column headers, output the number of fields
		*	indicated by headers (if less than or equal). If there are more
		*	user-provided column headers than fields, augment the field generation.
		
		IF tlUseColumnHeaders
			IF EMPTY (txColumnHeaders)
				lcHeaders = ALLTRIM (laFields[1, 1])
				FOR X = 2 TO lnFields
					lcHeaders = lcHeaders + EOL + ALLTRIM (laFields[X, 1])
				ENDFOR
			ELSE
				lcHeaders = STRTRAN (txColumnHeaders, ',', EOL)	
			ENDIF
			lnHeaders = ALINES (laHeaders, lcHeaders)		&&	Convert delimited string to array.
		ELSE
			lnHeaders = 0
		ENDIF

		lnAddedFields = 0					&&	Modify if the header info adds beyond fields.
		IF lnHeaders > 0
			IF lnFields < lnHeaders			&&	Populate extra fields
				lnAddedFields = lnHeaders - lnFields
				lnOutputFields = lnFields
			ELSE
				lnOutputFields = lnHeaders			
			ENDIF
		ELSE
			lnOutputFields = lnFields
		ENDIF

		*	Setup HTML phrases
		
		lcHTMLStart = HTML_BEGIN + EOL + HTML_HEADER + EOL + HTML_BODY_BEGIN + EOL;
			+ lcHTMLHeader + HTML_BREAK + HTML_BREAK
		lcHTMLEnd = HTML_BODY_END + EOL + HTML_END + EOL
		lcTableStart = '<' + 'table nowrap cols=' ;
			+ TRANSFORM (2 + lnAddedFields) ;
			+ ' cellpadding=5>' + EOL
		lcTableEnd = '</' + 'table>' + EOL
		lcRowStart = '<' + 'tr nowrap>' 
		lcRowEnd = '</' + 'tr>' 
		lcCellStart = '<' + 'td>'
		lcCellEnd = '</' + 'td>'
		
		*	Create a string for extra cells, if any.
		lcExtraCells = ''
		IF lnAddedFields > 0
			lcExtraCells = REPLICATE (lcCellStart + HARD_SPACE + lcCellEnd, lnAddedFields)
		ENDIF
		
		*	Create table header HTML if indicated. 		
		lcHeaderCells = ''
		IF lnHeaders > 0
			FOR X = 1 TO lnHeaders
				lcHeaderCells = lcHeaderCells + HTML_TABLE_HEADER_CELL_BEGIN;
					+ ALLTRIM (laHeaders[X]) + HTML_TABLE_HEADER_CELL_END
			ENDFOR
		ENDIF
		
*		CORE PROCESSING

		lcHTML = lcHTMLStart + lcTableStart + lcHeaderCells		&&	Create initial HTML string
		SCAN 													&&	Add rows
			lcRow = lcRowStart
			FOR lnField = 1 TO lnOutputFields
				lcRow = lcRow + lcCellStart + TRANSFORM (EVALUATE (laFields [lnField, 1])) + lcCellEnd
			ENDFOR
			lcHTML = lcHTML + lcRow + lcExtraCells + lcRowEnd
		ENDSCAN
		lcHTML = lcHTML + lcTableEnd + lcHTMLEnd				&&	Create ending HTML string
		lnLinesWritten = STRTOFILE (lcHTML, lcHTMLOutputFile)					&&	Write to file

		IF lnLinesWritten = 0
			tcNotOKMessage = 'Unable to write to HTML output file.'
		ENDIF
*		END CORE PROCESSING

	ENDIF
	
	*	Restore environment
	
	IF NOT EMPTY (lnOldWorkArea)
		SELECT (lnOldWorkArea)
	ENDIF
	
	IF NOT EMPTY (lcOldPath)
		SET PATH TO &lcOldPath 
	ENDIF
	
	IF llDeletedWasOff
		SET DELETED OFF
	ENDIF
	
	IF NOT EMPTY (lcSafety)	
		lcSafety = IIF (llSafetyWasOn, 'ON', 'OFF')
		SET SAFETY &lcSafety
	ENDIF
	
	*	Report any errors, if indicated.
	
	
	IF llReportHere AND NOT EMPTY (tcNotOKMessage)
		WAIT WINDOW 'TabletoHTML: ' + tcNotOKMessage
	ELSE
		IF NOT EMPTY (tcNotOKMessage)
			tcNotOKMessage = 'TabletoHTML: ' + tcNotOKMessage
		ENDIF
	ENDIF
	
ENDPROC
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform