using VBA, create an Excel spreadsheet of email details from .msg files saved in a file folder. Can't see email body

Question

I have several thousand MS Outlook email files (.msg) saved in a file folder. I need to create a spreadsheet which shows certain details from these emails. This includes the date the email was sent, the sender and recipient email address, the subject line, the body of the email, the number of attachments, the name of the file and the filepath to where it was stored.

I have put together a script which returns information, but the cells for the sender and recipient emails and the message body are blank.

    Sub import_msg_files()

' Turn off alerts etc

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False

' Define Variables

Dim i As Long
Dim inPath As String
Dim thisFile As String
Dim Msg As MailItem
Dim ws As Worksheet
Dim myOlApp As Outlook.Application
Dim MyItem As Outlook.MailItem

Set myOlApp = CreateObject("Outlook.Application")

' Allow User to Select Folder contain emails

With Application.FileDialog(msoFileDialogFolderPicker)
   .AllowMultiSelect = False
        If .Show = False Then
            Exit Sub
        End If
    On Error Resume Next
    inPath = .SelectedItems(1) & "\"
End With
      
' Create a new worksheet and give it headers in row 1

Sheets.Add After:=ActiveSheet
Set ws = ThisWorkbook.ActiveSheet

ws.Cells(1, 1) = "Sent Date/Time"
ws.Cells(1, 2) = "Senders Email Address"
ws.Cells(1, 3) = "Email Sent To"
ws.Cells(1, 4) = "Subject"
ws.Cells(1, 5) = "Body"
ws.Cells(1, 6) = "Attachments Count"
ws.Cells(1, 7) = "Filename"
ws.Cells(1, 8) = "Folder"

' Starting on row two, begin looping through the .msg files in the folder selected and populating cells with the relevant data from each .msg file.
' New row for each .msg file.

thisFile = Dir(inPath & "*.msg")
i = 2

Do While thisFile <> ""
    Set MyItem = myOlApp.CreateItemFromTemplate(inPath & thisFile)
    ws.Cells(i, 1) = MyItem.SentOn
    ws.Cells(i, 2) = MyItem.Sender
    ws.Cells(i, 3) = MyItem.To
    ws.Cells(i, 4) = MyItem.Subject
    ws.Cells(i, 5) = MyItem.Body
    ws.Cells(i, 6) = MyItem.Attachments.Count
    ws.Cells(i, 7) = thisFile
    ws.Cells(i, 8) = inPath
    i = i + 1
    thisFile = Dir()
Loop

'Clear mind and start reading emails.

Set MyItem = Nothing
Set myOlApp = Nothing

Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True

End Sub

Any help in getting these fields to populate would be greatly appreciated.