将 Outlook 正文提取到 Excel VBA

Question

在搜索多项内容并出现错误后，如何在 vba 脚本中按“f5”将电子邮件正文复制到 Excel 表 /csv 中，其中每一行 = 下面的一个新单元格。

谢谢

对不起，这只会给我带来麻烦。 到目前为止我尝试过的http://smallbusiness.chron.com/export-outlook-emails-excel-spreadsheets-41441.html

如何使用 VBA 或宏将 Outlook 邮件消息复制到 Excel 中

http://www.vbforums.com/showthread.php?415518-RESOLVED-outlook-the-macros-in-this-project-are-disabled

http://www.ozgrid.com/forum/showthread.php?t=181512

还有一些，去年。

Answer 1

这对你有用。 我们基本上是将电子邮件正文拆分为基于新行的数组。 请注意，如果电子邮件正文中有空行，这将产生空白单元格。

Public Sub SplitEmail() ' Ensure reference to Word and Excel Object model is set
    Dim rpl As Outlook.MailItem
    Dim itm As Object
    Set itm = GetCurrentItem()
    If Not itm Is Nothing Then
        Set rpl = itm.Reply
        rpl.BodyFormat = olFormatHTML
        'rpl.Display
    End If
    Dim objDoc As Word.Document
    Set objDoc = rpl.GetInspector.WordEditor
    Dim txt As String
    txt = objDoc.Content.text
    Dim xlApp As Excel.Application
    Set xlApp = CreateObject("Excel.application")
    xlApp.Visible = True
    Dim wb As Excel.Workbook
    Set wb = xlApp.Workbooks.Add
    Dim i As Long
    For i = LBound(Split(txt, Chr(13)), 1) To UBound(Split(txt, Chr(13)), 1)
        wb.Worksheets(1).Range("A" & i + 1).Value = Split(txt, Chr(13))(i)
    Next i
End Sub
Function GetCurrentItem() As Object
    Dim objApp As Outlook.Application
    Set objApp = Application
    On Error Resume Next
    Select Case TypeName(objApp.ActiveWindow)
    Case "Explorer"
    Set GetCurrentItem = objApp.ActiveExplorer.Selection.Item(1)
    Case "Inspector"
    Set GetCurrentItem = objApp.ActiveInspector.CurrentItem
    End Select
    GetCurrentItem.UnRead = False
    Set objApp = Nothing
End Function

Answer 2

Outlook 对象模型无法识别正文中的线条。 您可以尝试在 Outlook 中调整任何检查器窗口的大小，并查看正文线条是如何更改的。

无论如何，您可以尝试使用 Word 对象模型来获取准确的线条。 Outlook 使用 Word 作为电子邮件编辑器。 Inspector 类的WordEditor属性返回表示消息正文的 Document 类的实例。 您可以在第 17 章：使用项目实体一文中阅读有关所有可能方式的更多信息。

如何从 Visual Basic 自动化 Microsoft Excel 一文解释了如何从任何外部应用程序自动化 Excel。