ord vba replace the variable text with variable images to make offer products with images

[tanzinim]

Good morning
sorry but my knowledge of VBA is limited.

I have to make offers and bills with a word document RTF (exported from Access 2007) with the codes that need to be replaced with images (photos).
The word sheet looks like this:

FOTO_Eclipse

FOTO_FORMA3

FOTO_Eclipse

FOTO_Eclipse

FOTO_FORMA3

FOTO_ALFA


In practice, the VBA code is to be found throughout the word document the string "FOTO_" read the adjacent code (eg Eclipse) and replace it with a photo that I find in a directory on the server.

The code I've written so far is as follows but I only work for the first code and ends without replacing all the others ... please help me where is the error?
Thanks Marco

Sub Replace_String_ImageNUOVO ()

Dim Message As String
As String Dim Title
As String Dim Default
As String Dim usertext
As String Dim PixPathandName
As Range Dim CurrentRange

PixPathandName = "J: \ APPS \ ACCESS \ MDB2007 \ FOTOxOFFERTE \"

September CurrentRange = Selection.Range

Selection.HomeKey wdStory

Selection.Find.ClearFormatting
With Selection.Find
.text = "FOTO_"
.Replacement.Text = ""
.forward = True
.Wrap = WdFindAsk
.format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Selection.Find.Execute
Selection.MoveRight Unit: = wdCharacter, Count: = 1
Selection.MoveRight Unit: = wdWord, Count: = 1, Extend: = wdExtend
Usertext = "FOTO_" & Selection.Range
With Selection.Find
.forward = True
.Wrap = WdFindContinue
Do While .Execute (FindText: = usertext) = True
Selection.InlineShapes.AddPicture FileName: = PixPathandName & Selection.Range & ".JPG", _
LinkToFile: = False, SaveWithDocument: = True
Loop
End With

CurrentRange.Select
End With
End Sub