InlineShapes.AddOLEObject without opening the MSWord UI - vba

Question

I am trying to use VBA to add an embedded OLE (Empty MSWord document, Icon:=True) from an open MSWord document without opening the User Interface for the newly created Empty MSWord document). The following VBA replaces the second paragraph in the current document with the MSWord OLE Icon, But it opens the MSWord Icon document in its own window.
Sub InsertOLEobject()
ActiveDocument.InlineShapes.AddOLEObject _
ClassType:="Word.Document", DisplayAsIcon:=True, _
Range:=ActiveDocument.Paragraphs(2).Range 'Replaces the second paragraph with the MSWord Icon
End Sub
Can anyone give me some advice?
The following is the latest VBA code to do what I wanted to do. The InlineShapes.AddOLEObject will not open the Word User Interface if you use an existing file. I was just hoping for a more elegant way without creating a file that needs to be deleted.
Sub InsertOLEobject()
Dim docNewBlank As Document
Set docNewBlank = Documents.Add
Set DocA = ActiveDocument
With docNewBlank
'Centering the paragraph within the blank document
.Paragraphs(1).Alignment = wdAlignParagraphCenter
'Saved the file to a temporary scratch location
.SaveAs FileName:="c:\temp\Blank.doc"
.Close 'Close the word document
End With
'Add the embedded MSWord OLE Icon
ActiveDocument.InlineShapes.AddOLEObject _
ClassType:="Word.Document", _
FileName:="c:\Temp\Blank.doc", _
DisplayAsIcon:=True, _
IconLabel:="Blank.doc", _
IconFileName:="WINWORD.EXE", _
Range:=ActiveDocument.Paragraphs(2).Range
'Set the filename of your choice
'Set the Range to the destination of the ole icon
'Set the icon to the path of your WINWORD.EXE
End Sub

Answer 1

FWIW I'm not sure I have followed exactly what you are trying to do, but I wonder whether this will do what you need (except the document isn't quite empty and will be a .docx rather than a .doc):
Sub embedNearlyEmptyWordDoc()
Dim appFullName As String
' Windows only, perhaps there is a better place to get this string
appFullName = Application.Path & Application.PathSeparator & "winword.exe"
With ActiveDocument
' insert a space somewhere "safe" (not necessarily where I have put it
.Range(0, 0).Text = " "
.Range(0, 1).Copy
.Range(0, 0).Text = ""
End With
' Alter this to put the doc where you want
ActiveDocument.Paragraphs(2).Range.PasteSpecial IconIndex:=0, Link:=False, Placement:=wdInLine, DisplayAsIcon:=True, DataType:=wdPasteOLEObject, IconFileName:=appFullName, IconLabel:="Blank.docx"
End Sub

Answer 2

The ultimate solution was to add "ActiveWindow.Close" after inserting the Word OLE Icon with a blank name; this closes the window just opened by the "ActiveDocument.InlineShapes.AddOLEObject". So I did not have to create a blank.doc first; so I deleted that VBA code.
I was asked what my goal was going into this project; my goal was to cut Tables and Images within a document and paste them in place into Word OLE objects icons. The resulting word file with all images and tables encapsulated into Word OLE object icons that can be used as an input to the Rational DOORS (DOORS) export Addin. I could have exported the images and tables in DOORS directly so they are viewable within DOORS but if you have ever double clicked on an image or table in DOORS you would find out that the OLE object opens within the cell and is very hard to edit, resize, or position. I separated the table function from the inlineshapes sub; my VBA code is as follows:
'================================================================================
' Cut all Tables and paste them into Word OLE Icons
'================================================================================
Sub IconizeInlineTables()
'================================================================================
Dim iTable As Table
Dim RngA As Range
Dim RngB As Range
Dim RngC As Range
Dim DocA As Document
Dim DocC As Document
Set DocA = ActiveDocument
For Each iTable In DocA.Tables
Set RngA = iTable.Range 'Go to the start of the table
RngA.Expand Unit:=wdTable
Set RngB = RngA.Duplicate 'Duplicate the range to keep track of table location
RngB.Collapse Direction:=wdCollapseEnd 'Collapse the Duplicate range to the point after the Table
RngA.Select
'MsgBox "Tables Left to Process =" & DocA.Tables.Count
Selection.Cut 'Cut the Table and put it in the paste buffer
'Insert the MSWord.doc OLE icon
ActiveDocument.InlineShapes.AddOLEObject _
ClassType:="Word.Document", _
FileName:="", _
LinkToFile:=False, _
DisplayAsIcon:=True, _
IconFileName:="WINWORD.EXE", _
IconLabel:="Table-" & iTableCount & ".doc", _
Range:=RngB
ActiveWindow.Close
'Expand the range to include the OLE icon then select the new range
With RngB
.Expand Unit:=wdParagraph
.Paragraphs(1).Style = wdStyleBodyText 'Apply the Body Text style
.Paragraphs(1).Format.Alignment = wdAlignParagraphCenter 'Center the paragraph
.InlineShapes(1).Select 'Select the inlineshape containing the OLE
End With
'Make sure that the InlineShape is the OLE icon
If InStr(1, RngB.InlineShapes(1).OLEFormat.ProgID, "Word.Document.", vbTextCompare) Then
Set DocC = RngB.InlineShapes(1).OLEFormat.Object 'Select the OLE Object
Set RngC = DocC.Paragraphs(1).Range 'Select the first Paragraph within the OLE Object
With RngC
.Paragraphs(1).Style = wdStyleBodyText 'Apply the Body Text style
.Paragraphs(1).Format.Alignment = wdAlignParagraphCenter 'Center the paragraph
.Collapse Direction:=wdCollapseEnd 'Collapse to just beyond end of paragraph
.MoveEnd Unit:=wdCharacter, Count:=-1 'Back the RngC up one character to not include the paragraph marker
.Select
.Paste 'Paste the Table cut with RngA.cut here
End With
Else 'Something I did not expect happened
MsgBox "Error: " & Selection.InlineShapes(1).OLEFormat.ProgID & "Not Expected"
End If
Next
End Sub
'================================================================================
' Cut all Figures and paste them into Word OLE Icons
'================================================================================
Sub IconizeInlineShapes()
'================================================================================
Dim iShape As InlineShape
Dim RngA As Range
Dim RngB As Range
Dim RngC As Range
Dim DocA As Document
Dim DocC As Document
Set DocA = ActiveDocument
Selection.GoTo What:=wdGoToSection, Which:=wdGoToFirst 'Start at the beginning of the document
For Each iShape In DocA.InlineShapes
If iShape.Type = wdInlineShapePicture Then
Set RngA = iShape.Range 'Set the range to the image
Set RngB = RngA.Duplicate 'Duplicate the range to keep track of location
RngB.Collapse Direction:=wdCollapseEnd 'Collapses to the end of the selection
RngA.Select
Selection.Cut 'Cut the image and put it in the paste buffer
'Insert the MSWord OLE icon
ActiveDocument.InlineShapes.AddOLEObject _
ClassType:="Word.Document", _
FileName:="", _
LinkToFile:=False, _
DisplayAsIcon:=True, _
IconFileName:="WINWORD.EXE", _
IconLabel:="Figure-" & DocA.InlineShapes.Count & ".doc", _
Range:=RngB
ActiveWindow.Close
'The inserted OLE is the next InlineShape to be found so you don't have to select it just loop around to next iShape
ElseIf InStr(1, iShape.OLEFormat.ProgID, "Word.Document.", vbTextCompare) Then 'Make sure iShape OLE object was next
Set DocC = iShape.OLEFormat.Object 'Select the OLE object
Set RngC = DocC.Paragraphs(1).Range 'Select the first Paragraph within the OLE Object
RngC.Paragraphs(1).Style = wdStyleBodyText 'Apply the Body Text style
RngC.Paragraphs(1).Format.Alignment = wdAlignParagraphCenter 'Center the paragraph
RngC.Collapse Direction:=wdCollapseEnd 'Collapse to just beyond end of paragraph
RngC.MoveEnd Unit:=wdCharacter, Count:=-1 'Back the RngC up one character to not include the paragraph marker
RngC.Select
RngC.Paste 'Paste the image cut with RngA.cut here
Else 'Something I did not expect happened
MsgBox "Warning: " & iShape.OLEFormat.ProgID & "Not handled by this software"
End If
Next
End Sub
Note the "IconFileName:="WINWORD.EXE" is generic but may have to be modified for your particular installation.