wait window nowait "Creating Word Document.Please wait..." * Word constants header file #include "wdconst.h" #define NL chr(13) #define TABULATE chr(9) lnFields=_CopyDataToClipBoard("employee","first_name,last_name,title,hire_date,notes") *** set the LOCALEID to English nlLocaleId=sys(3004) && Save local id =sys(3006,1033) && We will be sending instructions in English *** set the LOCALEID to English oWordDocument=createobject("word.application") && Create word object with oWordDocument .documents.add && New file * .Application.DefaultTableSeparator = "~" with .ActiveDocument .range.Paste .range.ConvertToTable(wdSeparateByTabs,,lnFields,,wdTableFormatGrid1,,,,,,,,,.f.) .range.find.Execute("~",,,,,,,,,chr(13),wdReplaceAll) && Restore memo para marks endwith lcTempDataDoc = sys(5)+curdir()+"T"+sys(2015)+".doc" with .ActiveDocument .saveas(lcTempDataDoc) && Save as a word doc for mailmerge .close(wdSaveChanges) && Close saving endwith .documents.add with .ActiveDocument.Mailmerge .OpenDataSource(lcTempDataDoc) && Set file as data source for mailmerge .EditMainDocument && Activate the main document * Write mailmerge text thinking not using a template .application.selection.TypeText("Dear,"+chr(13)) with .application.selection.font .name = 'Times New Roman' .Italic = .t. .size = 14 endwith .fields.add(.application.selection.range, 'First_Name') .application.selection.TypeText(',') .fields.add(.application.selection.range, 'Last_Name') with .application.selection.font .name = 'Times New Roman' .Italic = .f. .size = 10 endwith .application.selection.TypeText(NL+NL+'Please update your info and send back. Current notes are as follows:'+NL+NL) with .application.selection.font .name = 'Arial' .size = 12 .color = rgb(0,0,255) endwith .fields.add(.application.selection.range, 'Notes') * Send to a new doc - to check what we get .Destination = wdSendToNewDocument .Execute endwith .visible = .t. && Show word app .activate endwith wait clear **** Set the LocaleId to the previous value =sys(3006,val(nlLocaleId)) return ******************************************************************* * Insert a table in Word at specified bookmark - NonODBC safe way ******************************************************************* function _CopyDataToClipBoard lparameters tcTableName, tcFieldList lcOldAlias = alias() && Save alias select &tcFieldList ; from (tcTableName) ; nofilter into cursor crsTemp && Select recs into a cursor if reccount("crsTemp")=0 use in "crsTemp" return endif select crsTemp lnFields = fcount() lcTempFileName = "X"+sys(2015)+".tmp" handle = fcreate(lcTempFileName) && Create a temp file && Write header line for ix = 1 to lnFields =fwrite(handle, field(ix)) if ix < lnFields =fwrite(handle, TABULATE) endif endfor =fwrite(handle, NL) scan && Start scan..endscan for ix = 1 to lnFields =fwrite(handle, TypeConvert(ix) ) if ix < lnFields =fwrite(handle, TABULATE) endif endfor =fwrite(handle, NL) endscan lnSize=fseek(handle,0,2) =fseek(handle,0,0) _cliptext = fread(handle, lnSize) && Read file to clipboard =fclose(handle) erase (lcTempFileName) * Prepare text copied to clipboard in VFP which is much faster than Word OLE use in "crsTemp" if !empty(lcOldAlias) select (lcOldAlias) endif return lnFields function TypeConvert lparameters tnField lcType = type(field(ix)) if lcType = 'G' return '' endif luValue = eval(field(ix)) do case case lcType = "D" lcValue = dtoc(luValue) case lcType = "T" lcValue = ttoc(luValue) case lcType = "N" lcValue = padl(luValue,20," ") case lcType = "L" lcValue = iif(luValue,"Yes","No") case lcType $ "M" && Replace paragraph marks with "~" lcValue = strtran(luValue, chr(13)+chr(10), "~") case lcType $ "C" lcValue = luValue otherwise lcValue = "" endcase return alltrim(lcValue)Cetin