Option Explicit
Sub BatchProcess()
Dim strFileName As String
Dim strPath As String
Dim oDoc As Document
Dim oLog As Document
Dim oRng As Range
Dim oHeader As HeaderFooter
Dim oSection As Section
Dim fDialog As FileDialog
Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
With fDialog
.Title = "Select folder and click OK"
.AllowMultiSelect = False
.InitialView = msoFileDialogViewList
If .Show <> -1 Then
MsgBox "Cancelled By User", , _
"List Folder Contents"
Exit Sub
End If
strPath = fDialog.SelectedItems.Item(1)
If Right(strPath, 1) <> "\" _
Then strPath = strPath + "\"
End With
If Documents.Count > 0 Then
Documents.Close savechanges:=wdPromptToSaveChanges
End If
Set oLog = Documents.Add
If Left(strPath, 1) = Chr(34) Then
strPath = Mid(strPath, 2, Len(strPath) - 2)
End If
strFileName = Dir$(strPath & "*.doc?")
While Len(strFileName) <> 0
WordBasic.DisableAutoMacros 1
Set oDoc = Documents.Open(strPath & strFileName)
'
'Do what you want with oDoc here
For Each oSection In oDoc.Sections
For Each oHeader In oSection.Headers
If oHeader.Exists Then
Set oRng = oHeader.Range
oRng.Collapse wdCollapseStart
InsertMyBuildingBlock "ASAP 1", oRng
End If
Next oHeader
Next oSection
'record the name of the document processed
oLog.Range.InsertAfter oDoc.FullName & vbCr
'
oDoc.Close savechanges:=wdSaveChanges
WordBasic.DisableAutoMacros 0
strFileName = Dir$()
Wend
End Sub
Function InsertMyBuildingBlock(BuildingBlockName As String, HeaderRange As Range)
Dim oTemplate As Template
Dim oAddin As AddIn
Dim bFound As Boolean
Dim i As Long
bFound = False
Templates.LoadBuildingBlocks
For Each oTemplate In Templates
If InStr(1, oTemplate.Name, "Building Blocks") > 0 Then Exit For
Next
For i = 1 To Templates(oTemplate.FullName).BuildingBlockEntries.Count
If Templates(oTemplate.FullName).BuildingBlockEntries(i).Name = BuildingBlockName Then
Templates(oTemplate.FullName).BuildingBlockEntries(BuildingBlockName).Insert _
Where:=HeaderRange, RichText:=True
'set the found flag to true
bFound = True
'Clean up and stop looking
Set oTemplate = Nothing
Exit Function
End If
Next i
If bFound = False Then 'so tell the user.
MsgBox "Entry not found", vbInformation, "Building Block " _
& Chr(145) & BuildingBlockName & Chr(146)
End If
End Function
This works, using the ASAP 1 watermark that is in bold. ASAP 1 is a built-in building block, if i just rename this to ASAP, but save it in the same place with buildingblocks.dotx it wont work. What do i need to do to be able to use this with my custom building blocks?