Why does the image insertion macro in Word work weird?

Question

Macros

Wrote a primitive macro for inserting images via links in Word documents. Those. I have documents containing text that contains links to images from one particular site. You need to replace the links to the images themselves.

Sub Link2img()
    Dim TempData As DataObject
    Dim Count As Integer
    Dim ImgURL As String
    Dim ImgNum As String
    Count = 0
    Selection.HomeKey Unit:=wdStory
    Selection.Find.ClearFormatting
    With Selection.Find
        .Text = "https://aaa.bbb.com/images/?*.[jpng]{3}"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do While (.Execute = True)
            Selection.Find.Execute
            Selection.Copy
            Set TempData = New DataObject
            TempData.GetFromClipboard
            ImgURL = TempData.GetText
            Selection.Delete
            Selection.InlineShapes.AddPicture FileName:=ImgURL, LinkToFile:=False, SaveWithDocument:=True
            Count = Count + 1
        Loop
    End With
    If Count < 2 Then ImgNum = " изображение"
    If Count > 1 And Count < 5 Then ImgNum = " изображения"
    If Count > 4 Then ImgNum = " изображений"
    MsgBox ("Вставлено " & Count & ImgNum)
End Sub

I have not tried it in other versions, but in Word 2007 the macro inserts only every second, i.e. the even image plus the latest one, regardless of its even/odd parity and the total number of images. Can you please help me find the error?

Answer 1

Figured it out myself. The Selection.Find.Execute line in the Do While (.Execute = True) ... Loop was redundant. She forced, when finding a link, to immediately look for the next one and only then perform actions.

As a result, the macro should look like this:

Sub Link2img()
    Dim TempData As DataObject, Count As Integer, ImgURL, ImgNum As String
    Count = 0
    Selection.HomeKey Unit:=wdStory
    With Selection.Find
        .ClearFormatting
        .Text = "https://aaa.bbb.com/images/?*.[jpng]{3}"
        .Replacement.Text = ""
        .Forward = True
        .Wrap = wdFindContinue
        .Format = False
        .MatchCase = False
        .MatchWholeWord = False
        .MatchAllWordForms = False
        .MatchSoundsLike = False
        .MatchWildcards = True
        Do While (.Execute = True)
            Selection.Copy
            Set TempData = New DataObject
            TempData.GetFromClipboard
            ImgURL = TempData.GetText
            Selection.Delete
            Selection.InlineShapes.AddPicture FileName:=ImgURL, LinkToFile:=False, SaveWithDocument:=True
            Count = Count + 1
        Loop
    End With
    If Count < 2 Then ImgNum = " изображение"
    If Count > 1 And Count < 5 Then ImgNum = " изображения"
    If Count > 4 Then ImgNum = " изображений"
    MsgBox ("Вставлено " & Count & ImgNum)
End Sub

Answer 2

take a dozen pictures and compare options
or here