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

通过上面的代码，我得到了主题行的读数，创建/接收的日期以及是否已读取。我试图看看我是否可以在消息本身中获得一些独特的字符串数据。我收到的电子邮件格式如下：

消息ID：示例信息

用户：测试

Content1：test

Content2：test

Content3：test

如果您错误地收到此邮件，请提交服务请求。

新房间要求

的通知

赞助商：My_example@Test.com

活动类型：会议

活动标题：测试

预订日期：2015-12-02

房间：150

从：13：00 至：14：00

信息会随着每个请求而变化，但我想知道是否有人知道如何捕获将要通过的唯一字符串，以便我可以保留比当前手动条目快得多的请求日志和双重检查？

Answer 1

根据后续要求，以下代码将邮件正文拆分为单独的信息行。几个笔记：我完全从你的帖子中复制了你的信息，然后搜索了“新房间请求通知”。不用说，这个字符串应该始终启动您需要的信息块。如果它有所不同，那么我们必须考虑可能出现的消息类型。此外，您可能必须测试邮件正文如何分解各个行。当我将邮件复制并粘贴到Excel中时，每个换行符都是2行换行符（VBA中为Chr（10））。在某些情况下，它可能只是一个换行符。或者它可以是回车（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

Answer 2

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

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。这是一个帮助您入门的链接。回复以获得更多帮助。

Using VBA to read new Outlook Email?

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

新房间要求

2 个答案: