Question

我有以下代码用于从Outlook电子邮件中提取表格。

它仅查看最新的电子邮件。我需要在电子邮件的主题中使用匹配字符串，以识别要从中提取的电子邮件。

我需要在代码中添加什么？

Option Explicit

Sub impOutlookTable()

Dim wkb As Workbook
Set wkb = Workbooks.Add

Sheets("Sheet1").Cells.ClearContents

' point to the desired email
Const strMail As String = "first.last@outlook.com"

Dim oApp As Outlook.Application
Dim oMapi As Outlook.MAPIFolder
Dim oMail As Outlook.MailItem

On Error Resume Next
Set oApp = GetObject(, "OUTLOOK.APPLICATION")
If (oApp Is Nothing) Then Set oApp = CreateObject("OUTLOOK.APPLICATION")

On Error GoTo 0

Set oMapi = oApp.GetNamespace("MAPI").Folders(strMail).Folders("inbox")
Set oMail = oMapi.Items(oMapi.Items.Count)

' get html table from email object
Dim oHTML As MSHTML.HTMLDocument: Set oHTML = New MSHTML.HTMLDocument
Dim oElColl As MSHTML.IHTMLElementCollection
With oHTML
    .Body.innerHTML = oMail.HTMLBody
    Set oElColl = .getElementsByTagName("table")
End With

'import in Excel
Dim x As Long, y As Long
For x = 0 To oElColl(0).Rows.Length - 1
    For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
        Range("A1").Offset(x, y).Value = oElColl(0).Rows(x).Cells(y).innerText
    Next y
Next x

Set oApp = Nothing
Set oMapi = Nothing
Set oMail = Nothing
Set oHTML = Nothing
Set oElColl = Nothing

wkb.SaveAs "C:\Users\user\.spyder-py3\Outlook\tables.xlsx"

End Sub

Answer 1

如果您只想检索一封包含指定主题的电子邮件：

If oMapi.Items.Item(i).Subject = "Your subject here" Then 

'Some code here

End if

如果要检索具有指定主题的所有电子邮件：

For i = 1 To oMapi.Items.Count 
  If oMapi.Items.Item(i).Subject = "Your subject here" Then 
    'Some code here 
  End If 
Next i

我还没有测试过它，但是它会沿着这些方向出现，您可以看到Microsoft Online documentation for more information

从Excel识别具有特定主题的Outlook邮件

1 个答案: