Attachment Label is missing in OLEObject in VBA

Question

I am attempting to embed two files in a Word document, but only the first has a label in the document.

If I simply place the code above for another file, it displays the label for that file.

I am not sure if I am missing anything in the code. The actual result is shown below, but I need labels for both attachments.

Sub Attach_REL_BUS_Extract_To_Word()
    'Declare Word Variables
    Dim WrdApp, WrdDoc

    Dim strdocname
    On Error Resume Next

    'Declare Excel Variables
    Dim WrkSht
    Dim Rng
    
    ' Define paths to Excel and Word files
    wordFilePath = "D:\GIT\modules\core\bin/logs\Test.docx"

    ' VBScript to read data from Excel and export tables to Word with formatting

    ' Create Excel and Word objects
    Set objExcel = CreateObject("Excel.Application")

    ' Open Excel workbook


    'Create a new instance of Word
    Set WrdApp = CreateObject("Word.Application")
        WrdApp.Visible = False
        WrdApp.Activate
     
    
    'Create a new word document
    'Set WrdDoc = WrdApp.Documents.Add
     Set WrdDoc = WrdApp.Documents.Open(wordFilePath)

    
    
   
    Const ClassType = "Excel.Sheet.12"
    Const DisplayAsIcon = True
    Const IconFileName = "C:\WINDOWS\Installer\{90160000-000F-0000-1000-0000000FF1CE}\xlicons.exe"
    Const IconIndex = 1
    Const LinkToFile = False
    Const relFilename = "D:\GIT\modules\core\src\main\resources\config\relCount.xlsx"
    const relIconLabel="Rel Count Extract"
    Const busFilename = "D:\GIT\modules\core\src\main\resources\config\busCount.xlsx"
    const busIconLabel="Bus Count Extract"

   
    
    Set WrdRng1 = WrdDoc.Bookmarks("s_Bus_Count_Attachment").Range

    With WrdRng1
        set newole = .InlineShapes.AddOLEObject( ClassType, busFilename, LinkToFile, DisplayAsIcon, IconFileName, IconIndex, busIconLabel)
        With newole
           .Height = 80
           .Width = 140
        End With
    End With       
    
    Set WrdRng = WrdDoc.Bookmarks("s_Rel_Count_Attachment").Range

    With WrdRng
        set newole = .InlineShapes.AddOLEObject( ClassType, relFilename, LinkToFile, DisplayAsIcon, IconFileName, IconIndex, relIconLabel)
        With newole
           .Height = 80
           .Width = 140
        End With
    End With       
    

    
    
    WrdDoc.SaveAs wordFilePath
    objExcel.Quit
    WrdApp.Quit
    Set objExcel = Nothing
    Set WrdApp = Nothing


End Sub
Attach_REL_BUS_Extract_To_Word()

WScript.Quit

Answer 1

Below code worked for me. Little trick from OLEObject label not displaying when executing Word macro from Powershell helped.

Sub Attach_REL_BUS_Extract_To_Word()
'Declare Word Variables
Dim WrdApp, WrdDoc

Dim strdocname
On Error Resume Next

'Declare Excel Variables
Dim WrkSht
Dim Rng

' Define paths to Excel and Word files
wordFilePath = "D:\GIT\modules\core\bin/logs\Test.docx"

' VBScript to read data from Excel and export tables to Word with formatting

' Create Excel and Word objects
Set objExcel = CreateObject("Excel.Application")

' Open Excel workbook


'Create a new instance of Word
Set WrdApp = CreateObject("Word.Application")
    WrdApp.Visible = False
    WrdApp.Activate
 

'Create a new word document
'Set WrdDoc = WrdApp.Documents.Add
Set WrdDoc = WrdApp.Documents.Open(wordFilePath)

Const ClassType = "Excel.Sheet.12"
Const DisplayAsIcon = True
Const IconFileName = "C:\WINDOWS\Installer\{90160000-000F-0000-1000-0000000FF1CE}\xlicons.exe"
Const IconIndex = 1
Const LinkToFile = False
Const relFilename = "D:\GIT\modules\core\src\main\resources\config\relCount.xlsx"
Const relIconLabel = "Rel Count Extract"
Const busFilename = "D:\GIT\modules\core\src\main\resources\config\busCount.xlsx"
Const busIconLabel = "Bus Count Extract"



Set WrdRng1 = WrdDoc.Bookmarks("s_Bus_Count_Attachment").Range

With WrdRng1
    Set newole = .InlineShapes.AddOLEObject(ClassType, busFilename, LinkToFile, DisplayAsIcon, IconFileName, IconIndex, busIconLabel)
    newole.Delete
End With

With WrdRng1
    Set newole = .InlineShapes.AddOLEObject(ClassType, busFilename, LinkToFile, DisplayAsIcon, IconFileName, IconIndex, busIconLabel)
    With newole
       .Height = 80
       .Width = 140
    End With
End With



Set WrdRng = WrdDoc.Bookmarks("s_Rel_Count_Attachment").Range

With WrdRng
    Set newole = .InlineShapes.AddOLEObject(ClassType, relFilename, LinkToFile, DisplayAsIcon, IconFileName, IconIndex, relIconLabel)
    With newole
       .Height = 80
       .Width = 140
    End With
End With

WrdDoc.SaveAs wordFilePath
objExcel.Quit
WrdApp.Quit
Set objExcel = Nothing
Set WrdApp = Nothing

End Sub