Option Explicit
Sub TextbausteineExport()
Dim objTemplate As Template
Dim objBBT As BuildingBlockType
Dim objCat As Category
Dim objBB As BuildingBlock
Dim intCount As Integer
Dim intCountCat As Integer
Dim intCountBlocks As Integer
Dim objWord As Application
Dim objDoc As Document
Dim objSelection As Selection
Set objTemplate = Templates(p_cstrTemplateTextbausteine)
For intCount = 1 To objTemplate.BuildingBlockTypes.Count
Set objBBT = objTemplate.BuildingBlockTypes(intCount)
If objBBT.Categories.Count > 0 Then
For intCountCat = 1 To objBBT.Categories.Count
Set objCat = objBBT.Categories(intCountCat)
For intCountBlocks = 1 To objCat.BuildingBlocks.Count
Set objBB = objCat.BuildingBlocks(intCountBlocks)
"Baustein " & intCountBlocks & ": " & objBB.Name & vbCrLf
"Value: " & objBB.Value & vbCrLf & vbCrLf
If Dir("g:\tmp\" & objBB.name & ".docx") = "" Then
Set objWord = CreateObject("Word.Application")
Set objDoc = objWord.Documents.Add
objWord.visible = False
Set objSelection = objWord.Selection
objSelection.TypeText (objBB.Value)
Debug.Print "Nr." & intCountBlocks & ": " & "g:\tmp\" & objBB.name & ".docx"
objDoc.SaveAs ("g:\tmp\" & objBB.name & ".docx")
objDoc.Application.Quit
End If
Next
Next
End If
Next
End Sub
Sub GetExistingBuildingBlock()
Dim objTemplate As Template
Dim objBB As BuildingBlock
Set objTemplate = Templates(p_cstrTemplateTextbausteine)
Set objBB = objTemplate.BuildingBlockEntries.Item(1)
MsgBox objBB.Value
End Sub