Search for text in a newly created email

[JBates]

I have a vba button that creates and email and pastes the content of a Word document into the email body. It works great but I have an issue every so often where the content doesn't paste the first time but when I run it again it works. Seems like just a pasting problem. I would like some help creating a loop that searches the body of the email for a specific phrase and if it is not there to run the paste code again.

------------------------------------------------

Set WordDoc = WordApp.Documents.Open(filename:=DocLoc, ReadOnly:=False) 'Open Template
WordDoc.Content.Copy


Set OutApp = CreateObject("Outlook.Application") 'Create Outlook Application
Set OutMail = OutApp.CreateItem(0) 'Create Email

Application.Wait (Now + TimeValue("0:00:01"))

With OutMail
.SentOnBehalfOfName = "Testing - Do not Send"
.BCC = "Testing - Do not Send"
.subject = "Testing 123"

Set editor = .GetInspector.WordEditor
editor.Content.Paste

Application.CutCopyMode = False 'Clears the Clipboard

.Display 'To send without Displaying change .Display to .Send
End With

 

[JBates]

Sub ViewTemplate()
Dim DocLoc, filename As String
Dim WordDoc, WordApp, OutApp, OutMail, editor As Object


With Sheet1

Application.CutCopyMode = False 'Clears the Clipboard

    DocLoc = Sheet2.Range("F" & 2).Value 'Word Document Filename
    
    
    'Open Word Template
    On Error Resume Next 'If Word is already running
    Set WordApp = GetObject("Word.Application")
    If Err.Number <> 0 Then
    'Launch a new instance of Word
    Err.Clear
    'On Error GoTo Error_Handler
    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = False 'Make the application visible to the user
    End If
    
        Set WordDoc = WordApp.Documents.Open(filename:=DocLoc, ReadOnly:=False) 'Open Template
        WordDoc.Content.Copy
        
                                    
                                                  Set OutApp = CreateObject("Outlook.Application") 'Create Outlook Application
                                                  Set OutMail = OutApp.CreateItem(0) 'Create Email
                                                  
                                                  Application.Wait (Now + TimeValue("0:00:01"))
                                                  
                                                  With OutMail
                                                      .SentOnBehalfOfName = "Do not Send"
                                                      .BCC = "Testing - Do not Send"
                                                      .subject = "Testing 123"
                                                                                                      
                                                       Set editor = .GetInspector.WordEditor
                                                       editor.Content.Paste
                                                      
                                                       Application.CutCopyMode = False 'Clears the Clipboard
                                                                                                            
                                                      .Display 'To send without Displaying change .Display to .Send
                                                  End With
 
        
        
        WordDoc.Close 0
        Set OutMail = Nothing
        Set WordDoc = Nothing
        Set OutApp = Nothing
        WordApp.Quit
        Set WordApp = Nothing


End With


End Sub