>Hi - I need a routine to mail merge to Word... Here are the specifics...
>
>I plan to have a folder in the root directory of my app - in it will be a prepared Word document - ie. it will have fields for the address of the customer etc which will be in a temp table in my data folder
>
>From the program the user will choose certain criteria and the data will be put into the temp table ready for Word.
>
>I then want launch Word - I can do that :)
>and the whole thing merge to a new document...
>That's it!
>
>Easy?

WAIT window nowait "Creating Word Document.Please wait..."
* Word constants header file
#include "wdconst.h"
#DEFINE NL chr(13)
#DEFINE TABULATE chr(9)

* VFP3-5
*lcDataPath = home()+"samples\data\"
* VFP6
*lcDataPath = _samples+'\data\'
* Copy VFP data to clipboard
lcDataPath = _samples+'\data\' && tables path

SELECT * from (lcDataPath+"employee") where Title like "Sales%" into cursor Tempreport
lnFields=_CopyDataToClipBoard("Tempreport","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
PUBLIC oWordDocument
oWordDocument=createobject("word.application")	&& Create word object
WITH oWordDocument
  .documents.add	&& New file
  *  .Application.DefaultTableSeparator = "~"
  WITH .ActiveDocument
    .PageSetup.Orientation = wdOrientLandscape  && Set to landscape
    .Range.Paste      && Paste VFP data
    .Range.ConvertToTable(wdSeparateByTabs,,lnFields,,wdTableFormatContemporary,,,,,,,,,.f.) && Convert to table
    .Range.Find.Execute("~",,,,,,,,,"^p",wdReplaceAll) && Restore memo para marks
  ENDWITH
  =_SampleMerge(.T.) && Do mailmerge
  .visible = .t.  && Show word app
  .Activate  && Make it the active foreground app
ENDWITH
WAIT clear
**** Set the LocaleId to the previous value
=sys(3006,val(nlLocaleId))


*******************************************************************
* 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) ) && Write converting all to char type
    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 && Convert VFP data types to char
LPARAMETERS tnField
lcType = type(field(ix))
luValue = iif(lcType='G','',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)

FUNCTION _SampleMerge
LPARAMETERS tltoNewDoc,tlToPrinter
WITH oWordDocument
  lcTempDataDoc = sys(5)+curdir()+"T"+sys(2015)+".doc"
  WITH .ActiveDocument
    .SaveAs(lcTempDataDoc)  && Save as a word doc for mailmerge - datasource
    .Close(wdSaveChanges)   && Close saving
  ENDWITH

  .documents.add  && New file or open a template
  WITH .ActiveDocument.MailMerge
    .OpenDataSource(lcTempDataDoc) && Set saved file as data source for mailmerge (Directly a table could be set via ODBC)
    .EditMainDocument	&& Activate the main document
  ENDWITH
  .Application.Selection.TypeText("Dear,"+chr(13))
  with .Application.Selection.Font
  	.Name = 'Times New Roman'
  	.Italic = .t.
  	.Size = 14
  endwith
  .ActiveDocument.MailMerge.Fields.Add(.Application.Selection.Range, "LAST_NAME")
  .Application.Selection.TypeText(", ")
  .ActiveDocument.MailMerge.Fields.Add(.Application.Selection.Range, "FIRST_NAME")
  with .Application.Selection.Font
  	.Italic = .f.
  	.Name = 'Arial'
  	.Size = 10
  endwith
  .Application.Selection.TypeText(chr(13)+"Here is your notes data :"+chr(13)+chr(13))
  with .Application.Selection.Font
  	.Bold = .t.
  	.Color = rgb(0,0,255)
  endwith
  .ActiveDocument.MailMerge.Fields.Add(.Application.Selection.Range, "NOTES")
  with .Application.Selection.Font
  	.Bold = .f.
  	.Color = rgb(0,0,0)
  endwith
  .Application.Selection.TypeText(chr(13)+chr(13)+"As to our records you were hired on ")
  with .Application.Selection.Font
  	.Color = rgb(255,0,0)
  endwith
  .ActiveDocument.MailMerge.Fields.Add(.Application.Selection.Range, "HIRE_DATE")
  with .Application.Selection.Font
  	.Color = rgb(0,0,0)
  endwith
  .Application.Selection.TypeText(" with title [")
  .ActiveDocument.MailMerge.Fields.Add(.Application.Selection.Range, "TITLE")
  .Application.Selection.TypeText("]"+chr(13)+"Thanks"+chr(13)+"Yours Sincerely."+chr(13)+"Blah blah...")
  *!*	  WITH .ActiveDocument
  *!*	    .Close(wdDoNotSaveChanges)			&& Close w/o saving
  *!*	  ENDWITH
  if tlToNewDoc or tlToPrinter
    .ActiveDocument.MailMerge.Destination = wdSendToNewDocument
  	.ActiveDocument.MailMerge.Execute
*!*	  .ActiveDocument.Range.Find.Execute("^b",,,,,,,,,"^p^p[End of Merge]^p",wdReplaceAll) && Replace section breaks with para marks
  endif
  IF tlToPrinter
    .Application.Options.PrintBackGround = .t.
    .ActiveDocument.PrintOut(.t.)
    *!*	    	do while .Application.BackgroundPrintingStatus > 0 && Wait printing to finish
    *!*	    	enddo
    *!*	    	for each oDoc in .Documents
    *!*	    		oDoc.Close(wdDoNotSaveChanges)
    *!*	    	endfor
    *!*	    	oDoc = .null.
  ENDIF
ENDWITH

Cetin