问如何在两个不同的单元格中导出电子邮件体？

EN

Sub ImportEmails()

Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Outlook.Namespace
Dim IFolder As Outlook.MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range

Set OutlookApp = New Outlook.Application
'Outlook connection
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set wb = ThisWorkbook
'Select the folder to export emails, depending on the user´s folder name you must change it
Set IFolder = OutlookNamespace.GetDefaultFolder(olFolderInbox).Folders("Test")
Set ws = wb.Sheets("Imported")
i = 0

Application.ScreenUpdating = False

ws.Cells.Clear
'Create headers
ws.Range("A1").Value = "Date Time"
ws.Range("B1").Value = "Body"

'Condition to select the today date in case of blank and export the emails
If IsEmpty(Range("end_date").Value) = True Then
    Range("end_date").Value = "=today()"
End If

'Exporting proccedure
For Each OutlookMail In IFolder.Items
    'Date validation
    If DateValue(OutlookMail.ReceivedTime) >= DateValue(Range("start_date")) And DateValue(OutlookMail.ReceivedTime) <= DateValue(Range("end_date")) Then
        'Fill the worksheet cells with the emails
        ws.Range("A2").Offset(i, 0).Value = OutlookMail.ReceivedTime
        ws.Range("B2").Offset(i, 0).Value = OutlookMail.Body
    
        i = i + 1
    End If
Next OutlookMail
Application.ScreenUpdating = True

Set IFolder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

LRimpr = LastRow(ws)
Set rng = ws.Range("A2:B" & LRimpr)
 
'Sort the columns by newest to oldest using the worksheet last row
With rng
    .Sort Key1:=.Cells(1), Order1:=xlDescending, _
      Orientation:=xlTopToBottom, Header:=xlNo
End With

MsgBox "Emails are successfully imported", vbInformation, "Import complete"
ws.Activate
End Sub