Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Word mailmerge with excel error
Message
De
10/07/2007 11:08:36
 
 
À
10/07/2007 11:06:48
Cetin Basoz
Engineerica Inc.
Izmir, Turquie
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:
01238935
Vues:
5
Again, you are the greatest!

Thanks

Peter

>>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
Peter Cortiel
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform