使用 VBA 将电子邮件正文复制到 Excel

Question

我想选择特定电子邮件的正文，将其复制并粘贴到 Outlook 中。

我知道在电子表格中按 Ctrl + A 然后按 Ctrl + C 会更容易，但这是涉及报告自动化的更大过程的一部分。

Sub GetFromInbox()
     
    Dim olApp As Outlook.Application
    Dim olNs As Outlook.Namespace
    Dim olFldr As Outlook.MAPIFolder
    Dim olItms As Outlook.Items
    Dim olMail As Variant
    Dim i As Long
     
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace(”MAPI”)
    Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
    Set olItms = olFldr.Items
     
    olItms.Sort “Subject”
     
    i = 1
     
    For Each olMail In olItms
        If InStr(olMail.Subject, “Criteria") > 0 Then
            ThisWorkbook.Sheets("YourSheet").Cells(i, 1).Value = outMail.Body
            i = i + 1
        End If
    Next olMail
     
    Set olFldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
     
End Sub

我得到一个语法错误：

If InStr(olMail.Subject, “Criteria") > 0 Then

Answer 1

我会看两件事。首先，是您想要将邮件正文粘贴到实际称为“YourSheet”的工作表，其次，您引用的是 outMail.Body，其中 outMail 从未被标注或设置过尺寸。试试这个（假设要粘贴到的工作表称为“Sheet1”）。

Sub GetFromInbox()

Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olItms As Outlook.Items
Dim olMail As Variant
Dim i As Long

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set olFldr = olNs.GetDefaultFolder(olFolderInbox)
Set olItms = olFldr.Items

olItms.Sort "Subject"

i = 1

For Each olMail In olItms
    If InStr(1, olMail.Subject, "Criteria") > 0 Then
        ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value = olMail.Body
        i = i + 1
    End If
Next olMail

Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub