如何在带有 Excel VBA 的 Word 文档中使用 BuildingBlockEntry().insert 方法？

Question

Most of the code is copied from How to use VBA to insert Excel data into Word, and export it as PDF? .

Is there is any way to insert text from quickparts-buildingblocks in a Word document via Excel VBA?

This freezes Excel:

wordDoc.Application.Templates(...).BuildingBlockEntries("test").Insert Where:=Selection.Range, RichText:=True

Code:

Sub Generate()
Dim wb As Workbook
Set wb = ActiveWorkbook

Dim wsGenerator As Worksheet
Set wsGenerator = wb.Sheets("List")

Dim wordApp As Word.Application
Set wordApp = New Word.Application

Dim wordDoc As Word.Document
Dim name1, name2, name3, name4 As String
Dim n, j As Integer

n = wsGenerator.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row

For j = 2 To n

    Set wordDoc = wordApp.Documents.Open("C:\Users\" & Environ("username") & "\Desktop\ExcelTest\Template.docx")
        
    wordApp.Templates.LoadBuildingBlocks

    name1 = wsGenerator.Range("A" & j).Value
    name2 = wsGenerator.Range("B" & j).Value
    name3 = wsGenerator.Range("C" & j).Value
    name4 = wsGenerator.Range("D" & j).Value

    If name4 = "" Then
        wordDoc.Application.Templates( _
          Environ("AppData") & "\Microsoft\Document Building Blocks\1045\16\Building Blocks.dotx" _
          ).BuildingBlockEntries("test").Insert Where:=Selection.Range, RichText:=True
    End If

    With wordDoc.Content.Find
        .Execute FindText:="<<name1>>", ReplaceWith:=name1, Replace:=wdReplaceAll
        .Execute FindText:="<<name2>>", ReplaceWith:=name2, Replace:=wdReplaceAll
        .Execute FindText:="<<name3>>", ReplaceWith:=name3, Replace:=wdReplaceAll
        .Execute FindText:="<<name4>>", ReplaceWith:=name4, Replace:=wdReplaceAll
    End With

    wordDoc.ExportAsFixedFormat "C:\Users\" & Environ("Username") & "\Desktop\ExcelTest\" & wsGenerator.Range("A" & j).Value & " " & wsGenerator.Range("C" & j).Value & ".pdf", _
      wdExportFormatPDF

    wordDoc.Close (wdDoNotSaveChanges)

Next
End Sub

Answer 1

There are several issues with your code.

Firstly, wordDoc.Application is going to fail because Application is not a child object of the document. You have already set a variable, wordApp to point to the Word Application object and need to use that.

Secondly, you only need to load the building blocks once, not during each iteration of the loop.

Thirdly, in VBA a variable declaration of: Dim name1, name2, name3, name4 As String will result in only name4 being a string whilst all the have the default datatype of Variant.

With these issues corrected your code will be:

Dim wb As Workbook
Set wb = ActiveWorkbook

Dim wsGenerator As Worksheet
Set wsGenerator = wb.Sheets("List")

Dim wordApp As Word.Application
Set wordApp = New Word.Application

Dim wordDoc As Word.Document
Dim name1 As String, name2 As String, name3 As String, name4 As String
Dim n, j As Integer

n = wsGenerator.Range("A:A").Find(what:="*", searchdirection:=xlPrevious).Row

'load building blocks
Dim bblockSource As String
bblockSource = Environ("appdata") & "\Microsoft\Document Building Blocks\1045\16\Building Blocks.dotx"
wordApp.Templates.LoadBuildingBlocks

For j = 2 To n

    Set wordDoc = wordApp.Documents.Open("C:\Users\" & Environ("username") & "\Desktop\ExcelTest\Template.docx")
    

    name1 = wsGenerator.Range("A" & j).Value
    name2 = wsGenerator.Range("B" & j).Value
    name3 = wsGenerator.Range("C" & j).Value
    name4 = wsGenerator.Range("D" & j).Value

    If name4 = "" Then
        wordApp.Templates(bblockSource).BuildingBlockEntries("test").Insert Where:=wordApp.Selection.Range, RichText:=True
    End If

    With wordDoc.Content.Find
        .Execute FindText:="<<name1>>", ReplaceWith:=name1, Replace:=wdReplaceAll
        .Execute FindText:="<<name2>>", ReplaceWith:=name2, Replace:=wdReplaceAll
        .Execute FindText:="<<name3>>", ReplaceWith:=name3, Replace:=wdReplaceAll
        .Execute FindText:="<<name4>>", ReplaceWith:=name4, Replace:=wdReplaceAll
    End With

    wordDoc.ExportAsFixedFormat "C:\Users\" & Environ("Username") & "\Desktop\ExcelTest\" & wsGenerator.Range("A" & j).Value & " " & wsGenerator.Range("C" & j).Value & ".pdf", _
        wdExportFormatPDF

    wordDoc.Close (wdDoNotSaveChanges)

Next

You also need to be aware that your code does not shut Word down after you have finished with it which could lead to multiple hidden instances of Word.