#1
|
|||
|
|||
Extracting OLE objects in Word, bypass .pdf and .pptx
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 |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Bypass VBA macro password in Excel | daniel.smith.10 | Excel Programming | 2 | 07-11-2017 01:58 AM |
Macros to move objects prevents moving same objects with arrow keys | BruceM | Word VBA | 1 | 03-10-2015 08:20 AM |
How can I convert pptx to text format like Word, and later on create pptx too? | GetLost | PowerPoint | 0 | 01-11-2012 04:23 AM |
Shortcut to bypass all animations and go to next slide? | tinfanide | PowerPoint | 1 | 09-18-2011 09:03 AM |
Exchange Security Certificate Bypass | Mikelite | Outlook | 0 | 06-29-2010 05:35 AM |