Konu: Corbaya tuz - MailMerge
Word Mail Merge. Tek ozelligi word'un bugini hallediyor, word2007'de de bile calisiyor.
Bunu bugun foxite'da yayinladim. bence iyi kod:) Gavurlara verdikten sonra size niye vermiyim ( bu arada gavur Izmirden sevgilerle ):
Ornek kullanim kodu:
select firstName, lastName, notes ;
from (_samples+'data\employee') ;
where upper(title) like '%SALES%' ;
into cursor xx nofilter
* Template yoksa
WordMailMerger('xx')
* template ile
WordMailMerger('xx','c:\myFolder\MyPredefinedTemlate.doc') && with template
*WordMailMerger.prg
*Author: Cetin Basoz
*If you would use this:
* Do not modify any part w/o permission
* Do not remove this comment lines
Lparameters tcCursorName, tcTemplateDoc
Local lnSelect, lcTemp, lcTempDb
lnSelect = Select()
lcTemp = Forcepath(Sys(2015)+'.dbf',Sys(2023))
lcTempDb = Forcepath(Sys(2015)+'.dbc',Sys(2023))
Create Database (m.lcTempDb)
Select * From (m.tcCursorName) Into Table (m.lcTemp) Database (m.lcTempDb)
Use In (Juststem(m.lcTemp))
Close Databases
Set Database To
Select (m.lnSelect)
#Define wdOpenFormatAuto 0
#Define wdSendToNewDocument 0
#Define wdSendToPrinter 1
#Define wdSendToEmail 2
#Define wdSendToFax 3
#Define wdMergeSubTypeOther 0
#Define NL Chr(13)+Chr(10)
Wait Window Nowait "Creating Word Document.Please wait..."
Local lcConnection, lcSource, lcSQLStatement, lcSQLStatement1
Local nLocaleID, loWord,oWordEvents
lcConnection = "Provider=VFPOLEDB;Data Source="+m.lcTempDb
m.lcSource = Forcepath('dummy.udl',Sys(2023))
If !File( m.lcSource )
Strtofile('',m.lcSource)
Endif
lcSQLStatement = Textmerge('select * from [<<trim(JUSTSTEM(m.lcTemp))>>]')
lcSQLStatement1 = ''
*** 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
loWord=Createobject("word.application") && Create word object
oWordEvents = createobject('WordEvents',loWord)
Eventhandler(loWord,oWordEvents)
oWordEvents.tmpDb = m.lcTempDb
With loWord
If Empty(m.tcTemplateDoc) && No template
.documents.Add() && New file
Else
.documents.Add(m.tcTemplateDoc) && Open a template
Endif
With .ActiveDocument.Mailmerge
.OpenDataSource(m.lcSource, wdOpenFormatAuto,,,.T.,,,,,,, ;
m.lcConnection, m.lcSQLStatement, m.lcSQLStatement1)
.EditMainDocument && Activate the main document
Endwith
.Visible = .T. && Show word app
.Activate
Endwith
**** Set the LocaleId to the previous value
=Sys(3006,Val(nlLocaleId))
Define Class WordEvents As Session OlePublic
Implements ApplicationEvents2 In "C:\PROGRAM FILES\MICROSOFT OFFICE\OFFICE11\MSWORD.OLB"
oHook = Null
tmpDb = ''
Procedure Init(loHook)
This.oHook = loHook
Endproc
Procedure ApplicationEvents2_Quit() As VOID
If !Empty(This.tmpDb)
Set Safety Off
Delete Database (This.tmpDb) Deletetables
Endif
Eventhandler(This.oHook,This,.T.)
Endproc
Procedure ApplicationEvents2_DocumentChange() As VOID
Endproc
Procedure ApplicationEvents2_DocumentOpen(Doc As VARIANT) As VOID
Endproc
Procedure ApplicationEvents2_DocumentBeforeClose(Doc As VARIANT, Cancel As LOGICAL) As VOID
Endproc
Procedure ApplicationEvents2_DocumentBeforePrint(Doc As VARIANT, Cancel As LOGICAL) As VOID
Endproc
Procedure ApplicationEvents2_DocumentBeforeSave(Doc As VARIANT, SaveAsUI As LOGICAL, Cancel As LOGICAL) As VOID
Endproc
Procedure ApplicationEvents2_NewDocument(Doc As VARIANT) As VOID
Endproc
Procedure ApplicationEvents2_WindowActivate(Doc As VARIANT, Wn As VARIANT) As VOID
Endproc
Procedure ApplicationEvents2_WindowDeactivate(Doc As VARIANT, Wn As VARIANT) As VOID
Endproc
Procedure ApplicationEvents2_WindowSelectionChange(Sel As VARIANT) As VOID
Endproc
Procedure ApplicationEvents2_WindowBeforeRightClick(Sel As VARIANT, Cancel As LOGICAL) As VOID
Endproc
Procedure ApplicationEvents2_WindowBeforeDoubleClick(Sel As VARIANT, Cancel As LOGICAL) As VOID
Endproc
Enddefine