Excel VBA - Outlook 电子邮件到 Excel

Question

I've done a fair bit of searching but everything I've come up with is doing the opposite of what I'm trying to do.

I have a whole bunch of automatically generated emails that I get, and I want to translate them down into excel. Everything works, except that it dumps it exclusively into one cell. I would like this to have multiple rows of the email come through as multiple lines in excel.

For example, email body is this. This will have a variable number of rows, so I can't really just use Mid functions.

Hello,
Job AAA completed successfully.

ThingA1 = good
ThingA2 = error code 5

This entire string shows up under cell A2 (which, is kinda what I told it to do...but I have no idea how to tell it to put it as multiple IDs). I want it to show up as different cells (covering cells A2:A6 in this instance).

Sub ParseAllEmails()
'loop through the outlook inbox, find stuff with errors, parse/paste it in
Dim OutApp As Outlook.Application, OLF As Outlook.MAPIFolder, OutMail As Outlook.MailItem
Dim myReport As Boolean, zeroErrors As Boolean
Dim parseSht As Worksheet
Dim i As Long


'establish connection
Set OutApp = CreateObject("Outlook.Application")
Set OLF = OutApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set parseSht = ThisWorkbook.Sheets("parse")


'go through inbox looking for scheduler emails
For i = OLF.Items.Count To 1 Step -1
  If TypeOf OLF.Items(i) Is MailItem Then
    Set OutMail = OLF.Items(i)
    
    myReport = (LCase(Left(OutMail.Subject, 3)) = "job")
    zeroErrors = (InStr(1, LCase(OutMail.Subject), "errors=0") > 0)
    
    If myReport And Not zeroErrors Then
      parseSht.Range("A2:A500").Value = Trim(OutMail.Body)
      Exit Sub
    End If
  End If
Next
End Sub

Answer 1

First of all, I'd suggest replacing the following part where the code iterates over all items in the Inbox folder:

'go through inbox looking for scheduler emails
For i = OLF.Items.Count To 1 Step -1
  If TypeOf OLF.Items(i) Is MailItem Then
    Set OutMail = OLF.Items(i)
    
    myReport = (LCase(Left(OutMail.Subject, 3)) = "job")
    zeroErrors = (InStr(1, LCase(OutMail.Subject), "errors=0") > 0)
    
    If myReport And Not zeroErrors Then

Use the Find / FindNext or Restrict methods of the Items class which allow getting items that correspond to your conditions only. All you need is to iterate over the result collection and process such items after. Read more about these methods in the following articles:

• How To: Use Find and FindNext methods to retrieve Outlook mail items from a folder (C#, VB.NET)
• How To: Use Restrict method to retrieve Outlook mail items from a folder

To break the single message body string into separate lines you could use the Slit function available in VBA:

Dim strings() As String
strings = Split(mailItem.Body, vbNewLine)

So, you can detect the data which is required to be pasted and process these lines in the loop by adding each entry into a separate cell (if required).