Duplicate and alter text in a Word document using VBA Scripts -

Duplicate and alter text in a Word document using VBA Scripts -

i alter word document using word vba script. word document consists of bibliographic records. duplicate first occurrence of field \trf of each record , alter field label (into \ott). recorded vba script , works fine if position cursor in front end of first occurrence of \trf. vba script repeat alterations in entire document alter first occurrences of \trf. recording vba script keyboard keys (ctrl+f) plus text didn’t work. , attempts add together vba code vba script not successful.. right syntax have add together vba script?

original text: (this illustration displays 1 record, document contains more records)

\ppn 375496173 \ttt pour united nations autre regard sur l'art beti / bienvenu cyrille bela \trf cameroon \trf beti \trf sculpture \trf visual arts \dat 15-08-14 \dav 20140815 \sig afrika 47231 \isp text \end

text after alteration

\ppn 375496173 \ttt pour united nations autre regard sur l'art beti / bienvenu cyrille bela \trf cameroon \ott cameroon \trf beti \trf sculpture \trf visual arts \dat 15-08-14 \dav 20140815 \sig afrika 47231 \isp text \end

incorrect macro:

sub macrocountry() ' macrocountry macro activedocument.content.find 'search \ppn (beginning of record) , search \trf .text = "\ppn" .text = "\trf" 'the selection part of macro works fine, selects line, duplicates , changes field label selection.endkey unit:=wdline, extend:=wdextend selection.copy selection.moveright unit:=wdword, count:=1 selection.typeparagraph selection.moveup unit:=wdline, count:=1 selection.pasteandformat (wdformatoriginalformatting) selection.delete unit:=wdcharacter, count:=1 selection.moveup unit:=wdline, count:=1 selection.moveright unit:=wdword, count:=2, extend:=wdextend selection.typetext text:="\ott " end loop end sub

i'm trying find out little bit more ms word framework used exercise. seek this. precondition lines ending newlines each line paragraph.

sub insertlines() dim rng range dim integer dim doc document dim line string dim inblock boolean, found boolean set doc = thisdocument = 1 while < thisdocument.paragraphs.count line = doc.paragraphs(i).range.text if instr(line, "\ppn") > 0 inblock = true found = false end if if instr(line, "\end") > 0 inblock = false end if if inblock , not found if instr(line, "\trf") > 0 doc.paragraphs(i).range.insertafter "\ott " & mid(line, 5) found = true end if end if = + 1 wend end sub

i'm sure there more elegant solutions hope solution @ all. tried little bit regexp , find object more straightforward.

vba ms-word word-vba