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(home()+"samples\data\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

* Initialize some vars
IF type("oWordDocument") = "U"
  PUBLIC oWordDocument
ENDIF
IF type("goTable") = "U"
  PUBLIC goTable
ENDIF
IF type("gHwndWord") = "U"
  PUBLIC gHwndWord
ENDIF
* Initialize some vars

* Word object creation
DECLARE integer GetForegroundWindow in WIN32API
DECLARE short IsWindow in WIN32API integer

IF type("oWordDocument") = "O" ;
    and type("gHwndWord") = "N" ;
    and IsWindow(gHwndWord)	# 0 && Check if word window is alive
  oWordDocument=getobject(, "Word.application")	&& Get word object
ELSE
  oWordDocument=createobject("word.application")	&& Create word object
ENDIF
* Word object creation
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
  .visible = .t.								&& Show word app
  =_SampleMerge()
  .Activate
ENDWITH
WAIT clear
gHwndWord = GetForegroundWindow()	&& Save word window handle
Clear dlls
**** 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))
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)

FUNCTION _SampleMerge
WITH oWordDocument
  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	&& 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))
  .ActiveDocument.MailMerge.Fields.Add(.Application.Selection.Range, "LAST_NAME")
  .Application.Selection.TypeText(", ")
  .ActiveDocument.MailMerge.Fields.Add(.Application.Selection.Range, "FIRST_NAME")
  .Application.Selection.TypeText(chr(13)+"Here is your notes data :"+chr(13)+chr(13))
  .ActiveDocument.MailMerge.Fields.Add(.Application.Selection.Range, "NOTES")
  .Application.Selection.TypeText(chr(13)+chr(13)+"As to our records you were hired on ")
  .ActiveDocument.MailMerge.Fields.Add(.Application.Selection.Range, "HIRE_DATE")
  .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...")
ENDWITH