If you don't want to have the flicker as the documents are opened, open the documents invisibly. This can result in you not knowing whether the process is still running, but the easy answer to that is to use a progress indicator bar. You can download a userform to do this from my web site -
http://www.gmayor.com/Zips/ProgressBar.zip Extract the files from the zip and import to the VBA project. The following code has been adjusted to use that progress bar.
The code you were using is somewhat convoluted. It is neither necessary nor desirable to write a text string to the clipboard in order to write it to the document. You just have to set the range you have defined to the place where the text is to be inserted.
It appears that you want to locate the text "Discharge Pack" and insert a paragraph break after it and write the text to the start of that new paragraph. The following does that for the first instance of the found text (matching the case). Remove the line indicated to search for every instance.
Code:
Sub InsertText()
Dim Doc As Document, strTextToInsert As String, strTextToFind As String
Dim i As Long, docToOpen As FileDialog, sHght As Single
Dim rngToSearch As Word.Range
Dim oFrm As frmProgress
Dim PortionDone As Double
On Error GoTo Err_Exit
strTextToInsert = "Annual bonus rates for the last five years"
strTextToFind = "Discharge Pack"
Set docToOpen = Application.FileDialog(msoFileDialogFilePicker)
If docToOpen.Show = -1 Then
Set oFrm = New frmProgress
If docToOpen.SelectedItems.Count > 1 Then oFrm.Show vbModeless
Application.ScreenUpdating = False
For i = 1 To docToOpen.SelectedItems.Count
If docToOpen.SelectedItems.Count > 1 Then
PortionDone = i / docToOpen.SelectedItems.Count
oFrm.lblProgress.Width = oFrm.fmeProgress.Width * PortionDone
oFrm.Caption = "Processing document " & i - 1 & " of " & docToOpen.SelectedItems.Count
End If
'Open each document
Set Doc = Documents.Open _
(FileName:=docToOpen.SelectedItems(i), _
Visible:=False, _
AddtoRecentFiles:=False)
Set rngToSearch = Doc.Range
With rngToSearch.Find
Do While .Execute(FindText:=strTextToFind, MatchCase:=True)
rngToSearch.Collapse 0
rngToSearch.Text = vbCr & strTextToInsert
rngToSearch.Collapse 0
Exit Do 'If you only want to process the first instance
Loop
End With
Doc.Close SaveChanges:=wdSaveChanges
DoEvents
Next
Unload oFrm
Application.ScreenUpdating = True
MsgBox "Processing complete"
End If
lbl_Exit:
Set Doc = Nothing
Set docToOpen = Nothing
Set rngToSearch = Nothing
Exit Sub
Err_Exit:
MsgBox Err.Description & Err.Number
Err.Clear
GoTo lbl_Exit
End Sub