如何在不丢失表格格式的情况下将电子邮件从Outlook拉到Excel

Question

我有一个宏，当我输入文件夹名称时，它可以帮助我提取电子邮件。 我有内容，但是却失去了格式。

Option Explicit

Sub Outlook_Import()
    Dim O As Outlook.Application
    Set O = New Outlook.Application
    Dim ns As Namespace

    Set ns = GetNamespace("MAPI")
    Dim Inbox As MAPIFolder
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)

    Dim searchFolder As String
    searchFolder = InputBox("What is your subfolder name?")

    Dim subFolder As MAPIFolder

    Dim oMail As Outlook.MailItem
    Set oMail = O.CreateItem(olMailItem)

    Dim FileName As String
    Dim i As Integer
    Dim r As Long
    r = 2

    If searchFolder <> "inbox" Then
        Set subFolder = Inbox.Folders(searchFolder)
        i = 0

        If subFolder.Items.Count = 0 Then
            MsgBox "There are no messages in the Inbox."
            Exit Sub
        End If

        For Each oMail In subFolder.Items
            Cells(r, 1).Value = oMail.ReceivedTime
            Cells(r, 2).Value = oMail.Body
            r = r + 1
            i = i + 1
        Next oMail
    Else
        i = 0
        If Inbox.Items.Count = 0 Then
            MsgBox "There are no messages in the Inbox."
            Exit Sub
        End If

        On Error Resume Next

        For Each oMail In subFolder.Items
            Cells(r, 1).Value = oMail.ReceivedTime
            Cells(r, 2).Value = oMail.Body
            r = r + 1
            i = i + 1
        Next oMail
    End If 
End Sub

任何人都可以帮助我修改代码，这样我就不会丢失电子邮件正文的内容了。我的目标是将电子邮件从Outlook中的特定文件夹转移到excel上，之后我可以进行跟踪

谢谢。