VBA Word 2007- code is not working till end of document

[psthariharan]

Hi

PFA.

i am new to VBA coding. i have used the below code
for find a position and add the contents from a document to word template. But the instance is happening at one time. it is not going to end of document. could any help me. Document is attached from where the contents to be added to word template



Public Function AllCodesIntoTemplate(templateName As String) As Boolean
Dim txtCodeName As String, target As Template, I As Integer
Dim objBB As BuildingBlock
'Adds a whole document of autotext entries into template]
Selection.Find.ClearFormatting
With Selection.Find
.Text = ":BC:"
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
While Selection.Find.Execute
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.EndKey Unit:=wdLine, Extend:=wdExtend
txtCodeName = Left(Selection, Len(Selection) - 1)
Selection.MoveRight Unit:=wdCharacter, Count:=1
Selection.Extend
Selection.Find.ClearFormatting
With Selection.Find
.Text = ":EC:"
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute
Selection.MoveLeft Unit:=wdCharacter, Count:=4, Extend:=wdExtend
For I = 1 To Templates.Count
If templateName = Templates(I).Name Then
Set target = Templates(I)
Set objBB = target.BuildingBlockEntries.Add(txtCodeName, wdTypeCustomAutoText, "General", Selection.Range)
'CodeIntoTemplate = True
Selection.ExtendMode = False
Selection.Find.ClearFormatting
With Selection.Find
.Text = ":BC:"
.Forward = True
'.Wrap = wdFindContinue ' wdFindStop
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
End If
Next
Wend
Exitfunction:
Exit Function
End Function




Thanks in advance

[gmaxey]

Try:


Sub Test()
AllCodesIntoTemplate "Normal.dotm"
End Sub
Public Function AllCodesIntoTemplate(strTemplateName As String) As Boolean
Dim oRng As Range
Dim i As Long, oTargetTemplate As Template
Dim strName As String
Dim oBB As BuildingBlock
For i = 1 To Templates.Count
If strTemplateName = Templates(i).Name Then
Set oTargetTemplate = Templates(i)
End If
Next i
Set oRng = ActiveDocument.Content
With oRng.Find
.ClearFormatting
.Text = ":BC:<*@:EC:"
.Wrap = wdFindStop
.MatchWildcards = True
Do While .Execute
With oRng
.MoveEnd Unit:=wdCharacter, Count:=-4
.MoveStart Unit:=wdCharacter, Count:=4
'Use first ten characters (your code) as BB name.
strName = Mid(oRng.Text, 1, 10)
'Clip the name line
.MoveStart Unit:=wdParagraph, Count:=1
'Create the BB
Set oBB = oTargetTemplate.BuildingBlockEntries.Add(strName, wdTypeCustomAutoText, "General", oRng)
.Collapse wdCollapseEnd
End With
Loop
End With
End Function