VBA 中的 OLEObject 中缺少附件标签[重复]

Question

我尝试在 Word 文档中嵌入两个文件，但只有第一个文件在文档中具有标签。

如果我只是将上面的代码放在另一个文件中，它会显示该文件的标签。

我不确定代码中是否遗漏了任何内容。实际结果如下所示，但我需要两个附件的标签。

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

下面的代码对我有用。 从 Powershell 执行 Word 宏时不显示 OLEObject 标签的小技巧有帮助。

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

结束子