#include 'hbcompat.ch'
#define CRLF Chr(13) + Chr(10)
Function Main
Olemerge('c:\oleword\Dup.doc', '&#NOME#&;&#ENDERECO#&;&#NOMEEMP#&;&#FONEEMP#&;&#FONEEMP#&;&#ENDERECOEMP#&;&#BAIRROEMP#&;&#CIDADEEMP#&;&#CEPEMP#&', ;
'Teste; ADRESS Teste;Autocom Informatica;(99) 9999-9999;(99) 9999-9999;Rua de Exemplo, 1234; Centro; CidadeExemplo; 12345-678', )
Return
Function OLEMerge( cDOCFile, cVFields, cVWords, lDOCPreview )
LOCAL cHomeDir := " "
LOCAL oDoc,oWord,oText,oFind,cFound,bError,cFile,cText
lDOCPreview := .t.
cFile := "c:\oleword\Dup.doc" //cHomeDir + cDOCFile
aVFields := StringToArray( cVFields, ";" )
aVWords := StringToArray( cVWords, ";" )
if File(cFile)
oWord :=TOleAuto():New( "Word.Application" )
oDoc :=oWord:Documents:Open( cFile )
oWord:Visible := .t.
oText:=oWord:Selection()
oFind:=oText:Find()
for i = 1 to len( aVFields )
// oFind:ClearFormatting := .T.
oFind:Text:=Alltrim(Upper(aVFields[i])) // "&#"+Alltrim(aVFields[i])+"#&"
oFind:Wrap:=1
oFind:MatchWildcards := .t.
if oFind:Execute()
cFound:=Alltrim(SubStr(aVFields[i],3,Len(Alltrim(aVFields[i]))-4))
cFound:=sSwap(cFound,{Chr(145),Chr(146)},"'")
cFound:=sSwap(cFound,{Chr(147),Chr(148)},'"')
//if Empty(cFound)
// exit
//endif
oText:TypeText( aVWords[i] )
endif
next
if lDOCPreview
oWord:Visible := .t.
else
// oWord:PrintOut()
oWord:Quit()
endif
// oWord:Visible := .T.
oWord:WindowState := 1
oWord:Quit()
/////////////////
else
alert( "Arquivo "+cFile+" nao encontrado." )
endif
return nil
**************************************************
Function StringToArray( cString, cSeparator )
LOCAL nPos
LOCAL aString := {}
cSeparator := ";"
cString := ALLTRIM( cString ) + cSeparator
DO WHILE .T.
nPos := AT( cSeparator, cString )
IF nPos = 0
EXIT
ENDIF
AADD( aString, SUBSTR( cString, 1, nPos-1 ) )
cString := SUBSTR( cString, nPos+1 )
ENDDO
RETURN ( aString )
**********************************
Function sSwap( cChar, c1, c2 )
LOCAL n1,n2:=-1,ac1,f
IF ValType(c1)="A"
ac1:=c1
FOR f=1 TO Len(ac1)
c1:=ac1[f]
WHILE .T.
n1:=At(Upper( c1 ),Upper( cChar ))
IF n1=0 .OR. n1=n2
EXIT
ENDIF
cChar:=SubStr( cChar, 1, n1-1 )+c2+SubStr( cChar, n1+Len(c1), Len(cChar)-Len(c1) )
n2:=n1
ENDDO
NEXT
ELSE
WHILE .T.
n1:=At(Upper( c1 ),Upper( cChar ))
IF n1=0 .OR. n1=n2
EXIT
ENDIF
cChar:=SubStr( cChar, 1, n1-1 )+c2+SubStr( cChar, n1+Len(c1), Len(cChar)-Len(c1) )
n2:=n1
ENDDO
ENDIF
return cChar
Só um detalhe Rochinha q fiz de um jeito mas existiria uma forma mais simples? Seguinte exemplo tem no Documento várias vezes &#NOME#& e ai como procedo? o q fiz como pode reparar no codigo acima foi colocar nos parametros da função várias vezes a TAG, mas queria algo automático, ou melhor, mais inteligente não eu saber qtas TAGS tem o DOC e sim a função procurar qtas TAGS existirem iguais as passadas no parametro e trocar todas....
Sds.
Grande abraço.
:)Pos
