Create an Outlook meeting invitation using text and formatting from a Word document using Excel VBA

I need to have the Word document open, or else I get errors.
Also, it takes a while to execute and tries opening the doc again in read-only.

Sub TeamsMeetingInvitation()
    Dim OutApp As Outlook.Application
    Dim OutMeet As Outlook.AppointmentItem
    Dim i As Long
    Dim sht As Worksheet
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim BodyContent As String
    
    Set sht = Worksheets("Scheduler")
   
    'Loop invitation creator
   
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        If sht.Range("G" & i).Value = "Invite" Then
       
            Set OutApp = Outlook.Application
            Set OutMeet = OutApp.CreateItem(olAppointmentItem)
            Set WordApp = CreateObject("Word.Application")
            Set WordDoc = WordApp.Documents.Open("C:\Path\to\document\z.docx", ReadOnly = True)
            WordDoc.Content.Copy
            BodyContent = WordDoc.Content.Text
            'Create this invitation
           
            With OutMeet
            .Start = sht.Range("E" & i).Value 
            .Duration = 30
            .Subject = sht.Range("N" & i).Value
            .BodyFormat = 2 'olFormatHTML
            .RequiredAttendees = sht.Range("M" & i).Value
            .MeetingStatus = olMeeting
            .GetInspector.WordEditor.Content.Paste
            .Display
            Application.Wait (Now + TimeValue("00:00:01"))
            End With
           
            With OutMeet.GetInspector.WordEditor.Content.Find
            .Text = "zzzzzz"
            .Replacement.Text = sht.Range("L" & i).Value 'Enter relevant date and time
            .Execute Replace:=2 ' 2 = wdReplaceAll
            'Application.Wait (Now + TimeValue("00:00:03"))
            End With
           
        End If
    Next i
    ' Clean up
    WordDoc.Close False
    WordApp.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing
    Set OutMeet = Nothing
    Set OutApp = Nothing
     
End Sub

The error:

z.docx is locked for editing by 'another user'.

I click to open a read-only copy, and then it works.

I think only minor changes are necessary:

Sub TeamsMeetingInvitation()
    Dim OutApp As Outlook.Application
    Dim OutMeet As Outlook.AppointmentItem
    Dim i As Long
    Dim sht As Worksheet
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim BodyContent As String

    'Get Content out of Word
    Set WordApp = CreateObject("Word.Application")
    Set WordDoc = WordApp.Documents.Open("C:\Path\to\document\z.docx", ReadOnly = True)
    WordDoc.Content.Copy
    BodyContent = WordDoc.Content.Text
    WordDoc.Close False
    WordApp.Quit
    Set WordDoc = Nothing
    Set WordApp = Nothing
   
    
    Set sht = Worksheets("Scheduler")
   
    'Loop invitation creator
   
    For i = 2 To Range("A" & Rows.Count).End(xlUp).Row
        If sht.Range("G" & i).Value = "Invite" Then
       
            Set OutApp = Outlook.Application
            Set OutMeet = OutApp.CreateItem(olAppointmentItem)
            'Create this invitation
           
            With OutMeet
            .Start = sht.Range("E" & i).Value 
            .Duration = 30
            .Subject = sht.Range("N" & i).Value
            .BodyFormat = 2 'olFormatHTML
            .Body = Replace(BodyContent, "zzzzzz", sht.Range("L" & i).Value)
            .RequiredAttendees = sht.Range("M" & i).Value
            .MeetingStatus = olMeeting
            .GetInspector.WordEditor.Content.Paste
            .Display
            Application.Wait (Now + TimeValue("00:00:01"))
            End With
           
        End If
    Next i
    ' Clean up
    Set OutMeet = Nothing
    Set OutApp = Nothing
     
End Sub