将Outlook电子邮件内容导出到Excel中

我收到格式如下的电子邮件：

我使用了某人在其他主题中获得的代码。 这里是代码：

Const xlUp As Long = -4162 Sub ExportToExcel(MyMail As MailItem) Dim strID As String, olNS As Outlook.NameSpace Dim olMail As Outlook.MailItem Dim strFileName As String '~~> Excel Variables Dim oXLApp As Object, oXLwb As Object, oXLws As Object Dim lRow As Long strID = MyMail.EntryID Set olNS = Application.GetNamespace("MAPI") Set olMail = olNS.GetItemFromID(strID) '~~> Establish an EXCEL application object On Error Resume Next Set oXLApp = GetObject(, "Excel.Application") '~~> If not found then create new instance If Err.Number <> 0 Then Set oXLApp = CreateObject("Excel.Application") End If Err.Clear On Error GoTo 0 '~~> Show Excel oXLApp.Visible = True '~~> Open the relevant file Set oXLwb = oXLApp.Workbooks.Open("C:\Sample.xlsx") '~~> Set the relevant output sheet. Change as applicable Set oXLws = oXLwb.Sheets("Sheet1") lRow = oXLws.Range("A" & oXLApp.Rows.Count).End(xlUp).Row + 1 '~~> Write to outlook With oXLws Dim MyAr() As String MyAr = Split(olMail.Body, vbCrLf) For i = LBound(MyAr) To LBound(MyAr) '~~> This will give you the contents of your email '~~> on separate lines Debug.Print MyAr(i) Next i ' '~~> Code here to output data from email to Excel File '~~> For example ' .Range("D" & lRow).Value = olMail.Subject .Range("A" & lRow).Value = olMail.SenderName .Range("C" & lRow).Value = olMail.Body .Range("B" & lRow).Value = olMail.ReceivedTime ' End With '~~> Close and Clean up Excel oXLwb.Close (True) oXLApp.Quit Set oXLws = Nothing Set oXLwb = Nothing Set oXLApp = Nothing Set olMail = Nothing Set olNS = Nothing End Sub 

我想将电子邮件的内容，主题，收件时间，发件人的内容导出到Excel文件中。 我设法出口所有这些领域，但我有问题的电子邮件的内容。 所有这些数字被放置在一个单元格中。 以下是它如何输出内容：

这里是我想要的内容：

或者像这样：

Answer 1

Outlook对象模型提供了三种处理项目主体的主要方法：

1. 正文 – 表示Outlook项目的明文正文的string。
2. HTMLBody – 表示指定项目的HTML正文的string。
3. Word编辑器 – 正在显示的消息的Microsoft Word文档对象模型。 Inspector类的WordEditor属性返回Word对象模型中的Document类的实例，您可以使用该对象设置消息正文。

你可以在第17章：使用物品主体中阅读更多关于这些方面的内容。 我们决定采用哪种方式来selectparsing邮件正文。