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
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