Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Word mailmerge with excel error
Message
De
10/07/2007 11:06:48
Cetin Basoz
Engineerica Inc.
Izmir, Turquie
 
 
À
10/07/2007 10:56:26
Information générale
Forum:
Visual FoxPro
Catégorie:
COM/DCOM et OLE Automation
Versions des environnements
Visual FoxPro:
VFP 9
OS:
Windows XP SP2
Divers
Thread ID:
01238712
Message ID:
01238932
Vues:
17
>Yes, I decided to go the word route, too.
>
>Peter

Then here is an old one using that approach:
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
Çetin Basöz

The way to Go
Flutter - For mobile, web and desktop.
World's most advanced open source relational database.
.Net for foxheads - Blog (main)
FoxSharp - Blog (mirror)
Welcome to FoxyClasses

LinqPad - C#,VB,F#,SQL,eSQL ... scratchpad
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform