将 Outlook 电子邮件信息导出到 Excel 工作簿

Question

每次在日程安排系统中预订房间时，我都会收到一封自动发送的电子邮件（在 Outlook 中），但随后必须检查并在另一个系统中反映该预订（这需要检查每个预订的特定信息并搜索收件箱）。我正在尝试确定是否有办法从消息部分提取信息（我发现了一些代码可以提取接收日期、主题行以及阅读状态，但无法确定如何提取消息正文信息我需要）

我是运行的代码由 Jie Jenn:

提供

Sub ListOutlookEmailInfoinExcel()
Dim olNS As Outlook.NameSpace
Dim olTaskFolder As Outlook.MAPIFolder
Dim olTask As Outlook.TaskItem
Dim olItems As Outlook.Items

Dim xlApp As Excel.Application
Dim xlWB As Excel.Workbook
Dim x As Long
Dim arrHeaders As Variant

Set olNS = GetNamespace("MAPI")
Set olTaskFolder = olNS.GetDefaultFolder(olFolderInbox)
Set olItems = olTaskFolder.Items

Set xlApp = CreateObject("Excel.Application")
xlApp.Visible = True
Set xlWB = xlApp.Workbooks.Add

On Error Resume Next
x = 2
arrHeaders = Array("Date Created", "Date Recieved", "Subject", "Unread?")

xlWB.Worksheets(1).Range("A1").Resize(1, UBound(arrHeaders)).Value = ""

Do

With xlWB.Worksheets(1)
If Not (olItems(x).Subjects = "" And olItems(x).CreationTime = "") Then

.Range("A1").Resize(1, UBound(arrHeaders) + 1) = arrHeaders
.Cells(x, 1).Value = olItems(x).CreationTime
.Cells(x, 2).Value = olItems(x).ReceivedTime
.Cells(x, 3).Value = olItems(x).Subject
.Cells(x, 4).Value = olItems(x).UnRead

x = x + 1
End If
End With


Loop Until x >= olItems.Count + 1

Set olNS = Nothing
Set olTaskFolder = Nothing
Set olItems = Nothing

Set xlApp = Nothing
Set xlWB = Nothing

End Sub

使用上面的代码，我可以读取主题行、日期 created/received 以及是否已阅读。此外，我正在尝试查看是否可以在消息本身中获取一些独特的字符串数据。我收到的邮件格式如下：

Message-ID: 示例信息

用户：测试

内容 1：测试

内容2：测试

内容 3：测试

如果您误收到此消息，请提交服务请求。

-新通知房间申请

赞助商：My_example@Test.com

事件类型：会议

活动名称：测试

预订日期：2015-12-02

房间：150

发件人：13:00 收件人：14:00

每个请求的信息都会有所不同，但我想知道是否有人知道如何捕获将要通过的唯一字符串，以便我可以记录比当前速度快得多的请求手动输入和 double-checks?

Answer 1

下面是连接到 Outlook 会话、导航到默认收件箱、然后遍历项目并将未读电子邮件添加到电子表格的示例。查看您是否可以根据需要修改代码，如果需要特定帮助，post 返回。

Sub LinkToOutlook()
    Dim olApp As Object
    Dim olNS As Object
    Dim olFolderInbox As Object
    Dim rOutput As Range

    Set olApp = CreateObject("Outlook.Application")
    Set olNS = olApp.getNamespace("MAPI")
    Set olFolderInbox = olNS.GetDefaultFolder(6) 'Gets the default inbox folder

    Set rOutput = Sheet1.Range("A1")

    For Each itm In olFolderInbox.items
        If itm.unread = True Then 'check if it has already been read
            rOutput.Value = itm.body
            Set rOutput = rOutput.Offset(1)
        End If
    Next itm

End Sub

或者，您可以直接在 Outlook 中编写代码来查找新邮件到达，并从那里测试它是否符合您的条件，如果符合，它可以写入 Excel。这里有一个 link 可以帮助您入门。 Post 回来寻求更多帮助。

Using VBA to read new Outlook Email?

Answer 2

根据后续要求，以下代码将消息正文拆分为单独的信息行。一些注意事项：我从您的 post 中完全复制了您的消息，然后搜索了 "Notice of NEW Room Request"。不用说，这个字符串应该总是开始你需要的信息块。如果它发生变化，那么我们必须考虑可能通过的消息类型。此外，您可能必须测试邮件正文如何拆分各个行。当我将您的消息复制并粘贴到 Excel 时，每个换行符都是 2 个换行符（VBA 中的 Chr(10)）。在某些情况下，它可能只有一个换行符。或者它可以是 Carriage Return (Chr(13))，甚至两者兼而有之。

事不宜迟，请参阅下面的代码并让我们知道问题。

Sub SplitBody()
    Dim sBody As String
    Dim sBodyLines() As String

    sBody = Range("A1").Value

    sBodyLines() = Split(Mid(sBody, InStr(sBody, "Notice of NEW Room Request"), Len(sBody)), Chr(10) & Chr(10))

    For i = LBound(sBodyLines) To UBound(sBodyLines)
        MsgBox (sBodyLines(i))
    Next i
End Sub

将 Outlook 电子邮件信息导出到 Excel 工作簿

Exporting Outlook Email information to Excel Workbook

email

excel

outlook

vba

-新通知房间申请