[VBA]
Private Sub CmbNumberOfFiles_Click()
NumberOfFiles = FormMain.lstDocuments.ListCount - 1
MsgBox "The number of files in the list: " & FormMain.lstDocuments.ListCount, vbInformation

End Sub

Private Sub cmdClose_Click()
Unload FormMain
End Sub

Public Sub CmdShow_Click()
lstDocuments.Clear
ReadDirectory ("P:\gws4all\Teksten\modeldocs\body\Beschikkingen")
ReadDirectory ("P:\gws4all\Teksten\modeldocs\body\brieven")
lblStatus.Caption = "Done with reading files..."
lblStatus.BackColor = &HC000&
End Sub

Sub ReadDirectory(Directories)
Static Running As Boolean

Dim AllDirs As New Collection
Dim NextDir As Integer
Dim DirectoryName As String
Dim SubDirectory As String
Dim i As Integer

If Running Then
Running = False
Else
Running = True

NextDir = 1
AllDirs.Add Directories
Do While NextDir <= AllDirs.Count
' Get the next directory to search.
DirectoryName = AllDirs(NextDir)
NextDir = NextDir + 1

' Read directories from DirectoryName.
SubDirectory = Dir$(DirectoryName & "\*.*", vbDirectory + vbNormal)
Do While SubDirectory <> ""
' Add the name to the list if
' it is a directory.
If UCase$(SubDirectory) <> "PAGEFILE.SYS" And _
SubDirectory <> "." And SubDirectory <> ".." _
Then
SubDirectory = DirectoryName & "\" & SubDirectory
On Error Resume Next
AllDirs.Add SubDirectory
End If
SubDirectory = Dir$(, vbDirectory)
Loop

If Not Running Then Exit Do
Loop

For i = 1 To AllDirs.Count
PosPunt = InStr(1, AllDirs(i), ".rtf", 1)
If PosPunt > 0 Then
FormMain.lstDocuments.AddItem txt & AllDirs(i)
End If
lblStatus.BackColor = &HC0&
lblStatus.Caption = "Busy reading files..."
DoEvents
Next i
Running = False
End If
End Sub
Private Sub cmbOpenADocument_Click()
On Error GoTo ErrHandler:
Documents.Open (FormMain.lstDocuments.Value)
ErrHandler:
If Err.Number = "13" Then
MsgBox "No document selected." & vbCrLf & vbCrLf & _
"Select a document and try again.", vbCritical, "No document selected!!!"
Else
Resume Next
End If
End Sub
Private Sub cmdReplaceParagraph_Click()
Dim FilesDone As Integer
Dim FilesNotDone As Integer
Dim FilesReadOnly As Integer
On Error GoTo ErrHandler
NumberOfFiles = FormMain.lstDocuments.ListCount - 1

Documents.Open "H:\Applicatiebeheer\Sjablonen in progress\Alinea-Vragen.doc"
Selection.WholeStory
Selection.Copy
ActiveDocument.Close wdDoNotSaveChanges

For x = 0 To NumberOfFiles
Documents.Open FormMain.lstDocuments.List(x, 0)
If ActiveDocument.ReadOnly = True Then
If ActiveDocument.Bookmarks.Exists("StartOfParagraph") Then
FilesReadOnly = FilesReadOnly + 1
End If
ActiveDocument.Close wdDoNotSaveChanges
Else
If ActiveDocument.Bookmarks.Exists("StartOfParagraph") Then
Set TeVervangenSelectie = ActiveDocument.Range _
(Start:=ActiveDocument.Bookmarks("StartOfParagraph").Range.Start, _
End:=ActiveDocument.Bookmarks("EndOfParagraph").Range.End)

TeVervangenSelectie.Select
Selection.Delete
Selection.Paste
Selection.TypeBackspace
Selection.TypeBackspace
ActiveDocument.Bookmarks.Add ("EndOfParagraph")
ActiveDocument.Close wdSaveChanges
FilesDone = FilesDone + 1
FormResult.LstResult.AddItem FormMain.lstDocuments.List(x, 0)
Else
If ActiveDocument.Name = "Beheer_GWS4All.dot" Then
Exit Sub
Else
ActiveDocument.Close
FilesNotDone = FilesNotDone + 1
GoTo NextFile
End If

End If
End If
NextFile:
Next
lblStatus.Caption = "Done replacing paragraph in files..."
lblStatus.BackColor = &HC000&
MsgBox "Replacement complete." & vbCrLf & vbCrLf & "Files done: " & FilesDone & _
vbCrLf & "Files skipped: " & FilesNotDone & vbCrLf & "Files read-only: " & _
FilesReadOnly, vbInformation, "Complete."
If FilesDone <> "0" Then
FormResult.Show
Else
End If

ErrHandler:
Select Case Err.Number
Case 5941
If ActiveDocument.Name = "Beheer_GWS4All.dot" Then
Exit Sub
Else
ActiveDocument.Close 'wdDoNotSaveChanges
FilesNotDone = FilesNotDone + 1
GoTo NextFile
End If
Case Else
Resume Next
End Select
End Sub

Private Sub cmdClearList_Click()
FormMain.lstDocuments.Clear
lblStatus.Caption = ""
lblStatus.BackColor = &H80000018
End Sub
[/VBA]

The user asked me for this. They manage about 600 rtf-files in which a certain paragraph changes every now and then. Instead of having to manually search each file for that paragraph they only have to create two bookmarks in those files.

The main function of this template is to search all of those files in two directories (including subdirs) for a certain bookmark. If that exists, it creates a selection range between the two bookmarks and replaces it with text from another file. So if they change that one file, all other files will be changed accordingly. There are some other functions as you can see, but that's the main one. It also has another small form in which it shows the replaced files.

I translated it back to English for the non-Dutch boys and girls in here...