Question

背景
我在Outlook中扫描收件箱，并根据电子邮件的标题将结果报告给Excel电子表格。我将使用与Microsoft office关键字相同的示例，并说＆＃34; Office＆＃34;。

IE：Office：笔记本电脑问题。我需要获取发送邮件的用户名或电子邮件地址，以及电子邮件正文中的一些关键字。我找到了通过使用表和行来迭代拥有此关键字的项目的方法。

的问题
我无法找到一种方法将row.item从表中转换为电子邮件，也无法获得＆＃34; sender＆＃34;或者＆＃34; emailbody＆＃34;属性。

的代码
您需要添加Outlook引用

Option Base 1
Sub Outlook_ScanForEmails()
Const TxtTag  As String = "http://schemas.microsoft.com/mapi/proptag/"
Const TxtWordSubject As String = "Office:"
Dim OutTable As Outlook.Table
Dim OutRow As Outlook.Row
Dim OutEmail As Outlook.MailItem
Dim OutApp As Outlook.Application: Set OutApp = New Outlook.Application
Dim CounterEmails As Long
Dim TotalEmails As Long
Dim TxtFilter As String: TxtFilter = "@SQL=" & Chr(34) & TxtTag & "0x0037001E" & Chr(34) & " ci_phrasematch '" & TxtWordSubject & "'"
Dim TxtCourse As String
Dim DteReport As Date
Set OutTable = OutApp.Session.GetDefaultFolder(olFolderInbox).GetTable(TxtFilter)
    TotalEmails = OutTable.GetRowCount
    For CounterEmails = 1 To TotalEmails
    Set OutRow = OutTable.GetNextRow
    DteReport = OutRow("LastModificationTime")
    TxtCourse = OutRow("Subject")
    TxtCourse = Right(TxtCourse, Len(TxtCourse) - Len(TxtWordSubject))
    Next CounterEmails

End Sub

进一步的想法 我宁愿不遍历每封电子邮件，因为表格会缩小过程，只迭代我需要的行项目。

Answer 1

要提取Outlook电子邮件到Excel，请使用引用Microsoft Outlook View Control和MS Outlook 16.0对象库的Excel文件中的以下代码。

代码：

Sub GetFromOutlook()
Dim OutlookApp As Outlook.Application
Dim OutlookNamespace As Namespace
Dim wb As Workbook, ws As Worksheet
Dim Folder As MAPIFolder
Dim OutlookMail As Variant
Dim i As Integer
Set wb = ThisWorkbook
Set ws = wb.Sheets("Mail")
Set OutlookApp = New Outlook.Application
Set OutlookNamespace = OutlookApp.GetNamespace("MAPI")
Set Folder = OutlookNamespace.GetDefaultFolder(olFolderInbox).GetTable(TxtFilter)    
i = 1

For Each OutlookMail In Folder.Items
'here you can update the condition to which it should be extracted

    If OutlookMail.ReceivedTime > ws.Range("D" & i).Value And OutlookMail.Subject <> ws.Range("B" & i).Value Then 
            ws.Range("B1").Offset(i, 0).Value = OutlookMail.Subject
        ws.Range("C1").Offset(i, 0).Value = OutlookMail.ReceivedTime
        ws.Range("D1").Offset(i, 0).Value = OutlookMail.ReceivedTime
        ws.Range("E1").Offset(i, 0).Value = OutlookMail.SenderName
        ws.Range("F1").Offset(i, 0).Value = OutlookMail.Body
        i = i + 1
    End If
Next OutlookMail

Set Folder = Nothing
Set OutlookNamespace = Nothing
Set OutlookApp = Nothing

End Sub

Answer 2

根据我的评论，您可以从表格的entryID列中获取邮件项目。以下是如何实现此目的的示例。

Option Base 1
Sub Outlook_ScanForEmails()
Const TxtTag  As String = "http://schemas.microsoft.com/mapi/proptag/"
Const TxtWordSubject As String = "Office:"
Dim OutTable As Outlook.Table
Dim OutRow As Outlook.Row
Dim OutEmail As Outlook.MailItem
Dim OutApp As Outlook.Application: Set OutApp = New Outlook.Application
Dim CounterEmails As Long
Dim TotalEmails As Long
Dim TxtFilter As String: TxtFilter = "@SQL=" & Chr(34) & TxtTag & "0x0037001E" & Chr(34) & " ci_phrasematch '" & TxtWordSubject & "'"
Dim TxtCourse As String
Dim DteReport As Date

Set OutTable = OutApp.Session.GetDefaultFolder(olFolderInbox).GetTable()
    TotalEmails = OutTable.GetRowCount
    For CounterEmails = 1 To TotalEmails
    Set OutRow = OutTable.GetNextRow
    DteReport = OutRow("LastModificationTime")
    TxtCourse = OutRow("Subject")
    'Define a string for the EntryId
    Dim entryID As String
    'get EntrId
    entryID = OutRow("EntryID")
    'define a MailItem
    Dim mi As MailItem
    'Get the MailItem from the ID
    Set mi = OutApp.Session.GetItemFromID(entryID)
    'do something with the mail item
    TxtCourse = Right(TxtCourse, Len(TxtCourse) - Len(TxtWordSubject))
    Next CounterEmails

End Sub

获得＆＃34;发件人＆＃34;和＆＃34; emailbody＆＃34;性能

2 个答案: