vbams-wordvbscriptcreateoleobject

Attachment Label is missing in OLEObject in VBA


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.

enter image description here

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

Solution

  • 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