Hi, I am having trouble with this Word vba script. The idea is to have embedded OLEs inside a Word document (.pdf, .pptx and .docx). I only want to find the .docx files and extract those. What is happening is every OLE the script finds that are not .docx is being opened and then the script stops. I want to bypass the .pdf and .ppt files and just open the .docx OLEs. What am I doing wrong? Thanks in advance.

Sub ExtractEmbeddedDocObjects()


'
Dim i As Integer
Dim doc As Document
Set doc = ActiveDocument

EmbeddedItems = 0
If doc.InlineShapes.Count > 0 Then
For i = 1 To doc.InlineShapes.Count
If doc.InlineShapes(i).Type = wdInlineShapeEmbeddedOLEObject Then
If doc.InlineShapes(i).OLEFormat.Application = "Microsoft Word" Then
EmbeddedItems = EmbeddedItems + 1
End If
End If
Next i
End If

If doc.InlineShapes.Count > 0 And EmbeddedItems > 0 Then
DeletedShapes = 0
i = 1
Do While DeletedShapes < EmbeddedItems
If doc.InlineShapes(i - DeletedShapes).Type = wdInlineShapeEmbeddedOLEObject Then
If doc.InlineShapes(i - DeletedShapes).OLEFormat.Application = "Microsoft Word" Then
Debug.Print doc.InlineShapes(i - DeletedShapes).OLEFormat.Application
With doc.InlineShapes(i - DeletedShapes)
.Select
End With
Selection.InlineShapes(1).OLEFormat.DoVerb VerbIndex:=1
Selection.WholeStory
Selection.Copy
ActiveDocument.Close
Selection.Delete Unit:=wdCharacter, Count:=1
Selection.PasteAndFormat (wdFormatOriginalFormatting)
DeletedShapes = DeletedShapes + 1
Selection.MoveRight Unit:=wdCharacter, Count:=2
End If
End If
i = i + 1
'
End Sub