Why does assigning the body of an email (a String) to String object error?

I am trying, in the trivial case, to extract Outlook email bodies and paste them into a Worksheet.

However, assigning the .Body (a String) property of olMail object to the EmailBody variable (also a String) triggers an "Application-defined or object-defined error", at line EmailBody = .Body running the below code. I am using the same method seen on numerous other threads except looping through a restricted set of folder items. The olMail.Class = 43 (mailitem). Unsure why ActiveExplorer, GetInspector or the NewMailEx methods are necessary given the below code seems logical.

Why isn't this working?

CODE

Option Explicit

Sub Test()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    
        ' Part 1
        
            Dim wb              As Workbook, _
                ws              As Worksheet, _
                tStamp1         As String, _
                EmailBody       As String, _
                wsCount         As Integer, _
                j               As Integer
                
                j = 2
                Set wb = ThisWorkbook
                Set ws = wb.Worksheets("Sheet1")
                tStamp1 = Format(DateAdd("h", 10, Date - 3), "ddddd h:nn AMPM")
                
            Dim ol              As Outlook.Application, _
                ns              As Namespace, _
                fol             As MAPIFolder, _
                subFolderItems  As Outlook.Items, _
                olMail          As Object, _
                olMailID        As String, _
                StoreID         As String

                Set ol = New Outlook.Application
                Set ns = ol.GetNamespace("MAPI")
                Set fol = ns.Folders("[insert folder]").Folders("[insert folder]").Folders("[insert folder]")
                Set subFolderItems = fol.Items
                Set subFolderItems = subFolderItems.Restrict("[ReceivedTime] > '" & tStamp1 & "' ")
                       
        ' Part 2
            
            Do
                wsCount = wb.Worksheets.Count
                If wsCount > 1 Then
                    wb.Worksheets(2).Delete
                End If
                j = j + 1
            Loop Until wsCount = 1
            
            For Each olMail In subFolderItems
                With olMail
                    If .Subject Like "*[insert subject]*" Then
                        
                        .BodyFormat = olFormatPlain
                        EmailBody = .Body
                        
                        With wb
                            .Worksheets.Add After:=.Worksheets(1)
                            .Worksheets(2).Range("A1").Value = EmailBody
                        End With
                        ElseIf .Subject = "[insert subject]" Then
                            .Display
                    
                    End If
                End With
            Next olMail

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

EDIT #1

Substituted

                        olMailID = .EntryID
                        StoreID = fol.StoreID
                        Set olMail = ns.GetItemFromID(olMailID)

For

                        .BodyFormat = olFormatPlain

and the error now reverts to "Application-defined or object-defined error".

EDIT #2

Noticed in Locals window that the body carries no value

EDIT #3

So, tried MS suggestions found here but received the same error at line Set wdDoc = myInspector.WordEditor; which lead to here, implying an Outlook security feature is preventing the extraction. Not fully confident this is the cause but does anybody have a better idea?

Option Explicit

Sub Test()

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.Calculation = xlCalculationManual
    
        ' Part 1
        
            Dim wb              As Workbook, _
                ws              As Worksheet, _
                tStamp1         As String, _
                EmailBody       As String, _
                wsCount         As Integer, _
                j               As Integer
                
                j = 2
                Set wb = ThisWorkbook
                Set ws = wb.Worksheets("Sheet1")
                tStamp1 = Format(DateAdd("h", 10, Date - 3), "ddddd h:nn AMPM")
                
            Dim ol              As Outlook.Application, _
                ns              As Namespace, _
                fol             As MAPIFolder, _
                subFolderItems  As Outlook.Items, _
                olMail          As Object, _
                olMailID        As String, _
                StoreID         As String

                Set ol = New Outlook.Application
                Set ns = ol.GetNamespace("MAPI")
                Set fol = ns.Folders("[insert folder]").Folders("[insert folder]").Folders("[insert folder]")
                Set subFolderItems = fol.Items
                Set subFolderItems = subFolderItems.Restrict("[ReceivedTime] > '" & tStamp1 & "' ")
                              
            Dim myInspector As Outlook.Inspector, _
                wdDoc As Word.Document, _
                wdRange As Word.Range
                       
        ' Part 2
            
            Do
                wsCount = wb.Worksheets.Count
                If wsCount > 1 Then
                    wb.Worksheets(2).Delete
                End If
                j = j + 1
            Loop Until wsCount = 1
            
            For Each olMail In subFolderItems
                With olMail
                    If .Subject Like "*[insert subject]*" Then

                        .Display
                        Set myInspector = .GetInspector
                        Set wdDoc = myInspector.WordEditor
                        Set wdRange = wdDoc.Range(0, wdDoc.Characters.Count)
                        wdRange.InsertBefore ("EMAIL BODY")
                         
                    End If
                End With
            Next olMail

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic

End Sub

EDIT #4

Here is the same approach as first described. I have copied it exactly and still find the same error at same place, so this must be security or Outlook upgrade related.

EDIT #5

So, after rethinking through the problem, have tried navigating around the plausible security issue by running the below code in Outlook. Yet, the same error appears at line .SaveAs (Str), olTXT (enumeration and syntax seem fine).

Option Explicit

Sub Test()
        
    Dim ol              As Application, _
        ns              As Namespace, _
        fol             As MAPIFolder, _
        subFolderItems  As Items, _
        olMail          As Object, _
        Str             As String, _
        tStamp1         As String

        tStamp1 = Format(DateAdd("h", 10, Date - 1), "ddddd h:nn AMPM")
        Set ol = New Application
        Set ns = ol.GetNamespace("MAPI")
        Set fol = ns.Folders("[insert folder]").Folders("[insert folder]").Folders("[insert folder]")
        Set subFolderItems = fol.Items
        Set subFolderItems = subFolderItems.Restrict("[ReceivedTime] > '" & tStamp1 & "' ")
    
    For Each olMail In subFolderItems
        With olMail
            If .Subject Like "*[insert subject]*" Then
                
                Str = "[insert file path]"
                Str = Str & .Subject & ".txt"

                .SaveAs (Str), olTXT
            
            End If
        End With
    Next olMail

End Sub

EDIT #6

Looked here which lead to here where this section

is important. No Admin rights so avenue of enquiry is moot.