Выберите тело письма, скопируйте его и вставьте в excel с помощью VBA

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 

поэтому я не знаю, что мне не хватает или делать неправильно, так, пожалуйста, помогите, как я не являюсь очень опытный с VBA.

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