*<Llamada>
lcFile=TextFromWord("datospersonales.doc", ,.T.,.T.)
SELECT MiTabla
REPLACE MICAMPO_memo with FILETOSTR(lcFile)
*</Llamada>
***************************************************
PROCEDURE TextFromWord
LPARAMETERS xcDocument,xcFileDest,xlQuitblank,xlAddSpace
***************************************************
* Nombre Original: PROCEDURE Extrae_texto_word
***************************************************
* PUblicada por ARiel en Comunidad
* Adaptada por Fidel.
*********************************
* xcDocument: Ruta y nombre de archivo (puede omitirse)
* xcFileDest: Ruta y nombre de un archivo de salida (Puede omitirse)
* xlQuitBlank: Quitar espacios en blanco Alltrim()
* xlAddSpace: Agrega una linea en blanco entre parágrafos.
********************************************************************
* LPARAMETERS xcDocument,xcFileDest,xlQuitblank,xlAddSpace
*********************************************************************
LOCAL lnAsc,lcObten,i,j,lcChar,llAdd,WordApp,oWord,nfop
LOCAL ARRAY gaimp(33)
gaImp[1]=153
gaImp[2]=161
gaImp[3]=166
gaImp[4]=169
gaImp[5]=171
gaImp[6]=174
gaImp[7]=187
gaImp[8]=188
gaImp[9]=189
gaImp[10]=190
gaImp[11]=191
gaImp[12]=193
gaImp[13]=196
gaImp[14]=201
gaImp[15]=203
gaImp[16]=205
gaImp[17]=207
gaImp[18]=209
gaImp[19]=211
gaImp[20]=214
gaImp[21]=218
gaImp[22]=220
gaImp[23]=225
gaImp[24]=228
gaImp[25]=233
gaImp[26]=235
gaImp[27]=237
gaImp[28]=239
gaImp[29]=241
gaImp[30]=243
gaImp[31]=246
gaImp[32]=250
gaImp[33]=252
IF EMPTY(xcDocument)
xcDocument= GETFILE('DOC')
ENDIF
IF EMPTY(xcDocument)
RETURN ""
ENDIF
WordApp = CREATEOBJECT("word.application")
IF VARTYPE(WordApp)#"O"
RETURN
ENDIF
xcFileDest=EVL(xcFileDest,ADDBS(FULLPATH(""))+JUSTSTEM(xcDocument)+".txt")
IF FILE(xcFileDest)
DELETE FILE &xcFileDest
ENDIF
WAIT WINDOW "Abriendo "+JUSTFNAME(xcDocument)+"..." AT 12,15 nowait
WordDoc = WordApp.Documents.Open(xcDocument)
WordDoc.Select
oWord=WordApp.ActiveDocument
nParagraph=oWord.paragraphs.count
lcDe="/"+TRANSFORM(nParagraph)
LOCAL ARRAY gaParag(nParagraph),gaChar(1),gaColec(1)
FOR i=1 TO nParagraph
WAIT WINDOW "Importando parágrafo "+TRANSFORM(i)+lcDe+"..." AT 12,15 nowait
lcTexto=oWord.Paragraphs(i).Range.text
lcObten=""
FOR j=1 TO LEN(lcTexto)
lcChar=SUBSTR(lcTexto,j,1)
lnASc=ASC(lcChar)
llAdd=.T.
DO case
CASE BETWEEN(lnAsc,32,126)
CASE ASCAN(gaImp,lnAsc)#0
OTHERWISE
llAdd=.F.
ENDCASE
IF llAdd
LcObten=lcObten+lcChar
ENDIF
NEXT
gaParag[i]=IIF(xlQuitBlank,ALLTRIM(lcObten),lcObTen)
NEXT
WAIT WINDOW "Cerrando Microsoft Word ®..." AT 12,15 nowait
WordDoc.Close()
WordDoc = null
WordApp.QUIT
WordApp = null
WAIT WINDOW "Escribiendo archivo..." AT 12,15 nowait
nfop=Fcreate(xcFileDest)
FOR i=1 TO nParagraph
IF !EMPTY(gaParag[i])
=FPUTS(nfop,gaParag[i])
IF xlAddSpace
=FPUTS(nfop,"")
ENDIF
ENDIF
NEXT
=FCLOSE(nfop)
WAIT clear
RETURN xcFileDest
ENDPROC