RE: Word Automation: OLE exception error 5981 in Windows 7

Author: Bill Arnold

Posted: 2010-06-04 at 13:14:37

Ken,

I've kept a distance from Word automation after hearing of compatibility

headaches, but I couldn't resist in a few cases. Just took at look and I see

that in these cases I'm creating a new doc, and none involves a reference to

an existing file (new/empty or prev existing) for the operation.

FWIW, two examples follow below.

Bill

A small example

IF ISNULL(THISFORM.oWord)

THISFORM.oWord=CREATEOBJECT("Word.Application")

ENDIF

oDoc=THISFORM.oWord.Documents.Add()

THISFORM.simplECHART1.editCopy()

THISFORM.oWord.Selection.PasteSpecial(.F., .F., 0, .F., 3)

oDoc.PrintOut

oDoc.Close(0)

RELEASE oDoc

oDoc = .null.

A larger example, a prg that generates HTML doc for table descriptions using

Word

**********************************************************************

* Program/Method....: TABLEDOC.PRG

* Purpose....: The DBC Documentation Tool

* Uses WORD to generate an HTML doc file

* Uses the FIELDS table to obtain field descriptions

**********************************************************************

* based on: http://www.inquiry.com/techtips/vfox_pro/10min/10min0600.asp

* This tool creates a Microsoft Word file that documents a VFP database.

*!* When you run the code below, you are prompted to choose a DBC file

to

*!* document. After you choose a DBC file, it creates a Word file with

the

*!* same name but with the .doc extension. This file contains a Word

table

*!* for every VFP table in the database. The output looks like the

following:

PARAMETERS whattodoc

PUBLIC tzipname,tsgname,tzipfname

public targetf,tzipname,caliasb,ccurdir

targetf = "c:\vls\bldlib\cl\rec_formats"

tzipfname = "c:\vls\bldlib\cl\samplib\recformats.zip"

caliasb = ALIAS()

ccurdir = CURDIR()

q_ans = MESSAGEBOX("This procedure"+CHR(13)+CHR(13)+ ;

"1. Requires MS Word"+CHR(13)+ ;

"2. Can be restarted any time"+CHR(13)+ ;

"3. Creates record format HTML files for the input table"+CHR(13)+ ;

"4. Places HTML files -> C:\VLS\BLDLIB\CL\REC_FORMATS"+CHR(13)+ ;

"5. And ZIPPED -> C:\VLS\BLDLIB\CL\SAMPLIB\RECFORMATS.ZIP"+CHR(13)+ ;

"Proceed?",4,m_product)

IF q_ans <> 6

RETURN

ENDIF

=MESSAGEBOX("IMPORT the saved HTML file into the RoboHelp topic, ;

and then in Robohelp select TOOLS-> OPTIONS and select USE DEFAULT ;

EDITOR instead of AUTO SELECT so RoboHelp can work with this WORD ;

created file",0,m_product)

IF EMPTY(whattodoc)

whattodoc = ' '

ENDIF

DO case

CASE ATC('allprofs',whattodoc) <> 0

DO doc_all_profs_tables

CASE ATC('dbc',whattodoc) <> 0

DO docdbc WITH whattodoc

CASE ATC('dbf',whattodoc) <> 0

DO docdbf WITH whattodoc

OTHERWISE

DO docdbf WITH whattodoc

endcase

CD (ccurdir)

IF !EMPTY(caliasb)

SELECT (caliasb)

endif

release targetf,tzipname,caliasb,ccurdir

RETURN

*

---------------------------------------------------------------------------

* Document all DBFs in PROFS ... creating an Word generred HTML file

* with the structure and field descriptions for the DBF

*

---------------------------------------------------------------------------

procedure doc_all_profs_tables

LOCAL clnames

cd (z_profs) && get into source files PROFS folder

dimension clnames(500)

prof_files = adir(clnames,"*.dbf")

IF prof_files = 0

=MESSAGEBOX("No DBFs found in PROFS",0,m_product)

RETURN

ENDIF

* =asort(clnames,aelement(clnames,1,1),0,1) && sort into

descending order

* m_iver = clnames(1) && e.g. ZC010028.EXE

FOR n = 1 TO prof_files

DO docdbf WITH clnames(n,1)

IF z_esc

EXIT

endif

ENDFOR

* The HTML files are in the target folder

DO zipup && move result files into samplib ZIP file

STORE .f. TO z_esc

RELEASE clnames

RETURN

*

---------------------------------------------------------------------------

* Document a DBF ... create a word doc with the structure of the DBF

PROCEDURE docdbf

PARAMETERS cdbfname

#DEFINE wdToggle 9999998

#DEFINE wdCharacter 1

#DEFINE wdStory 6

#DEFINE wdMove 0

#DEFINE wdExtend 1

LOCAL lcDBCFile, loWord, loSelection, loDoc

LOCAL loTable, lnTable, lnTableCount

LOCAL ARRAY laTables[1], laFields[1]

lcDBFFile = cdbfname

IF !DIRECTORY(targetf)

MD (targetf)

ENDIF

IF EMPTY(lcdbFfile)

lcDBFFile = GETFILE("DBF", ;

"Select a DBF to Document", ;

"Select", ;

0,;

"Select a DBF to Document")

endif

IF EMPTY(lcDBFFile)

MESSAGEBOX("No Database Chosen")

RETURN

ENDIF

IF !FILE(lcdbffile)

=MESSAGEBOX(lcdbffile+" doesn't exist",0,m_product)

STORE .t. TO z_esc

RETURN

endif

*-- Fill an array with the names of

*-- the tables in the chosen DBC and

*-- then sort it by name

*!* OPEN DATABASE (lcDBCFile)

*!* lnTableCount = ADBOBJECTS(laTables,"TABLE")

*!* =ASORT(laTables,1)

loWord = CREATEOBJECT("Word.Application")

IF varTYPE(loWord) <> 'O'

=MESSAGEBOX("Unable to create an instance of Microsoft Word",0,m_product)

STORE .t. TO z_esc

RETURN

endif

loWord.Visible = .T.

loDoc = loWord.Documents.Add()

loSelection = loWord.Selection

loSelection.TypeText("Documentation for "+TRIM(lcDBFFile))

loSelection.TypeText(CHR(13))

loSelection.TypeText(CHR(13))

*!* FOR lnTable = 1 TO lnTableCount

*-- create a small header

loSelection.TypeText(CHR(13))

loSelection.TypeText("Table: ")

*-- Make the name of the table bold

*-- by toggling Bold on, typing the text,

*-- and then toggling Bold off

loSelection.Font.Bold = wdToggle

* loSelection.TypeText(laTables[lnTable])

* loSelection.TypeText(DBF())

loSelection.TypeText(cdbfname)

loSelection.Font.Bold = wdToggle

loSelection.TypeText(CHR(13))

loSelection.TypeText("Field Listing:")

loSelection.TypeText(CHR(13))

loSelection.TypeText(CHR(13))

loSelection.MoveLeft(wdCharacter,1)

*-- Open the table about to be

*-- documented and get its structural

*-- information

SELECT 0

USE (lcDBFFile) again

lnFieldCount = AFIELDS(laFields)

=ASORT(lafields)

*-- Create a Word table with the number of rows

*-- equal to the number of fields in the

*-- VFP table + 1. The extra row is for the

*-- column headers

* loTable = loDoc.Tables.Add(loSelection.Range,lnFieldCount+8,4)

loTable = loDoc.Tables.Add(loSelection.Range,lnFieldCount+1,5)

&& add 1 field for DESC

loTable.Cell(1,1).Range.Text = "Name"

loTable.Cell(1,2).Range.Text = "Description"

c2width = lotable.cell(1,2).width

lotable.cell(1,2).width = c2width * 2.2

loTable.Cell(1,3).Range.Text = "Type"

loTable.Cell(1,4).Range.Text = "Length"

loTable.Cell(1,5).Range.Text = "Dec"

* Fill in the rows of the Word table with field information

FOR lnField = 1 TO lnFieldCount

loTable.Cell(lnField+1,1).Range.Text = laFields[lnField,1]

loTable.Cell(lnField+1,2).Range.Text = getdesc(laFields[lnField,1])

&& get description

x3 = lotable.cell(lnField+1,2).width

lotable.cell(lnField+1,2).width = c2width * 2.2 && widen

desc column

loTable.Cell(lnField+1,3).Range.Text = laFields[lnField,2]

loTable.Cell(lnField+1,4).Range.Text =

ALLTRIM(STR(laFields[lnField,3]))

loTable.Cell(lnField+1,5).Range.Text =

ALLTRIM(STR(laFields[lnField,4]))

ENDFOR

* Add lines at the end of the table showing # fields, # records and today's

datetime

*!*

*!* lnfield = lnfield + 4

*!* lotable.cell(lnfield+1,1).range.text =

ALLTRIM(STR(FCOUNT(ALIAS())))+" fields"

*!* lnfield = lnfield + 1

*!* lotable.cell(lnfield+1,1).range.text =

ALLTRIM(STR(reccount(ALIAS())))+" records"

*!* lnfield = lnfield + 1

*!* lotable.cell(lnfield+1,1).range.text = 'As of '+TTOC(DATETIME())

*-- Jump to end of document

* The table is closed now. Add more stuff below the table

loSelection.MoveEnd(wdStory)

loSelection.Start = loSelection.End

loSelection.TypeText(CHR(13))

loSelection.TypeText(CHR(13))

loSelection.TypeText(ALLTRIM(STR(FCOUNT(ALIAS())))+" fields")

loSelection.TypeText(CHR(13))

loSelection.TypeText(ALLTRIM(STR(reccount(ALIAS())))+" records")

loSelection.TypeText(CHR(13))

loSelection.TypeText('As of '+TTOC(DATETIME()))

* Name .DOC file the same name as the DBF name, with an .HTM extension

* e.g. c:\vls\profs\html\comgrab.htm

lcsavedfile = ADDBS(targetf)+JUSTstem(lcdbffile)+'.htm'

* make sure file to be saved doesn't exist

IF FILE(lcsavedfile)

SET SAFETY OFF

ERASE (lcsavedfile)

SET SAFETY ON

ENDIF

* for SAVEAS doc, see http://msdn.microsoft.com/en-us/library/aa662158.aspx

loDoc.SaveAs(lcSavedFile,8) && for WORD 2000 -

can't use filtered html for some reason, but 8 (heavy html) works

* I had word 2002 on the gateway

machine, which works with 10 (smaller0

* loDoc.SaveAs(lcSavedFile,10) && 10 is filtered HTML, see

http://www.xefteri.com/articles/show.cfm?id=22

lodoc.Close

loWord.Quit()

lodoc = .null.

loword = .null.

USE

RETURN

* ----------------------------------------------------------------------

FUNCTION getdesc

PARAMETERS fieldn

LOCAL caliasb

caliasb = ALIAS()

IF !USED('theflds')

DO connect WITH 'fields'

ENDIF

IF z_esc

STORE .f. TO z_esc

RETURN '??? FIELDS table not available'

ENDIF

SELECT theflds

LOCATE FOR UPPER(TRIM(name)) == UPPER(TRIM(fieldn)) .and. !EMPTY(desc)

* .and. UPPER(TRIM(

LOCATE FOR UPPER(TRIM(name)) == UPPER(TRIM(fieldn)) .and. !EMPTY(desc)

IF FOUND()

SELECT (caliasb)

RETURN TRIM(theflds.desc)

ELSE

SELECT (caliasb)

RETURN ' ... '

ENDIF

SELECT (caliasb)

RETURN '???'

* -----------------------------------------------

PROCEDURE zipup

* Change below code to use right folders

* put result in BLDLIB\CL\SAMPLIB\xxxxxx.zip

CD (targetf) && get into target folder holding

CSV files

IF FILE(tzipfname)

SET safety OFF

ERASE (tzipfname)

SET SAFETY ON

ENDIF

* ZIP targetf "c:\vls\bldlib\cl\samplib\sampcsvs\*.csv"

* and

* move

* into tzipname "c:\vls\bldlib\cl\samplib\sampcsvs.zip"

go_lmutils.zip_using_fll(targetf,tzipfname) && zip

* Erase the CSV's and the work folder

CD (targetf)

SET safety OFF

ERASE *.htm

SET SAFETY ON

CD "c:\vls\bldlib\cl"

RD (targetf)

return

*

---------------------------------------------------------------------------

* Document a DBC ... create a word doc with the structure of

* each table in the DBC

*

----------------------------------------------------------------------------

PROCEDURE docdbc

PARAMETERS cdbcname

#DEFINE wdToggle 9999998

#DEFINE wdCharacter 1

#DEFINE wdStory 6

#DEFINE wdMove 0

#DEFINE wdExtend 1

LOCAL lcDBCFile, loWord, loSelection, loDoc

LOCAL loTable, lnTable, lnTableCount

LOCAL ARRAY laTables[1], laFields[1]

lcDBCFile = cdbcname

IF EMPTY(lcdbcfile)

lcDBCFile = GETFILE("DBC", ;

"Select a Database to Document", ;

"Select", ;

0,;

"Select a Database to Document")

endif

IF EMPTY(lcDBCFile)

MESSAGEBOX("No Database Chosen")

RETURN

ENDIF

*-- Fill an array with the names of

*-- the tables in the chosen DBC and

*-- then sort it by name

OPEN DATABASE (lcDBCFile)

lnTableCount = ADBOBJECTS(laTables,"TABLE")

=ASORT(laTables,1)

loWord = CREATEOBJECT("Word.Application")

loWord.Visible = .T.

loDoc = loWord.Documents.Add()

loSelection = loWord.Selection

loSelection.TypeText("Documentation for "+lcDBCFile)

loSelection.TypeText(CHR(13))

loSelection.TypeText(CHR(13))

FOR lnTable = 1 TO lnTableCount

*-- create a small header

loSelection.TypeText(CHR(13))

loSelection.TypeText("Table: ")

*-- Make the name of the table bold

*-- by toggling Bold on, typing the text,

*-- and then toggling Bold off

loSelection.Font.Bold = wdToggle

loSelection.TypeText(laTables[lnTable])

loSelection.Font.Bold = wdToggle

loSelection.TypeText(CHR(13))

loSelection.TypeText("Field Listing:")

loSelection.TypeText(CHR(13))

loSelection.TypeText(CHR(13))

loSelection.MoveLeft(wdCharacter,1)

*-- Open the table about to be

*-- documented and get its structural

*-- information

USE (laTables[lnTable])

lnFieldCount = AFIELDS(laFields)

*-- Create a Word table with the number of rows

*-- equal to the number of fields in the

*-- VFP table + 1. The extra row is for the

*-- column headers

loTable = loDoc.Tables.Add(loSelection.Range,lnFieldCount+1,4)

loTable.Cell(1,1).Range.Text = "Name"

loTable.Cell(1,2).Range.Text = "Type"

loTable.Cell(1,3).Range.Text = "Length"

loTable.Cell(1,4).Range.Text = "Dec"

*-- Fill in the rows of the Word table with

*-- the field information

FOR lnField = 1 TO lnFieldCount

loTable.Cell(lnField+1,1).Range.Text = ;

laFields[lnField,1]

loTable.Cell(lnField+1,2).Range.Text = ;

laFields[lnField,2]

loTable.Cell(lnField+1,3).Range.Text = ;

ALLTRIM(STR(laFields[lnField,3]))

loTable.Cell(lnField+1,4).Range.Text = ;

ALLTRIM(STR(laFields[lnField,4]))

ENDFOR

*-- Jump to end of document

loSelection.MoveEnd(wdStory)

loSelection.Start = loSelection.End

ENDFOR

*-- Name .DOC file the same as the DBC name

*-- Remove .DBC from end of DBC name

lcSavedFile = SUBSTRC(lcDBCFile,1,LENC(lcDBCFile)-4)

loDoc.SaveAs(lcSavedFile,10)

loWord.Quit()

USE

CLOSE DATABASE

return

_______________________________________________

Post Messages to: ProFox@leafe.com

Subscription Maintenance: http://leafe.com/mailman/listinfo/profox

OT-free version of this list: http://leafe.com/mailman/listinfo/profoxtech

Searchable Archive: http://leafe.com/archives/search/profox

This message: http://leafe.com/archives/byMID/profox/D2199EFE190E406EAAAA1F4ACF4EB136@bills

** All postings, unless explicitly stated otherwise, are the opinions of the author, and do not constitute legal or medical advice. This statement is added to the messages for those lawyers who are too stupid to see the obvious.

©2010 Bill Arnold