in vba for excel, loop/iterate al lines in email

[sal21]

I need to loop/iterate in all lines in object of email, possible with vba for excel?

Note:
I dont remenber if i just have post a similar question.

[Rudi]

Hi Sal,

Can you clarify what you mean by "in object of email"?
TX

[sal21]

Hi Sal,

Can you clarify what you mean by "in object of email"?
TX

in internal of the email (body) text.

[Rudi]

Is the object you refer to an actual attachment in an email message or must the code loop through the lines of text in the body of the email.

[sal21]

Is the object you refer to an actual attachment in an email message or must the code loop through the lines of text in the body of the email.

simply:
or must the code loop through the lines of text in the body of the email, from the top to the end of message

[Rudi]

Sorry for all the questions...
What is the purpose of looping?
Do you need to count lines to determine length of email or extract something from an email message?

[sal21]

Sorry for all the questions...
What is the purpose of looping?
Do you need to count lines to determine length of email or extract something from an email message?

yes!
or extract something from an email message with the mid, instr, lef, right ecc...

similar:

For Each msgLine In msgLines
.....
If Mid(....,4,5) ="99" then
debug.print msgLine
End if
Next

[Rudi]

OK... this is a bit out of my league...but if did manage to locate this thread with a lot of detail on copying an email body into Excel
Particularly this part in the middle of the thread:

To extract the contents from your email body, you can split it using SPLIT() and then parsing out the relevant information from it. See this example

Code: Select all

Dim MyAr() As String
MyAr = Split(olMail.body, vbCrLf)

For i = LBound(MyAr) To LBound(MyAr)
    '~~> This will give you the contents of your email
    '~~> on separate lines
    Debug.Print MyAr(i)
Next i

I hope this can give you some idea of what to do?

[sal21]

OK... this is a bit out of my league...but if did manage to locate this thread with a lot of detail on copying an email body into Excel
Particularly this part in the middle of the thread:

To extract the contents from your email body, you can split it using SPLIT() and then parsing out the relevant information from it. See this example

Code: Select all

Dim MyAr() As String
MyAr = Split(olMail.body, vbCrLf)

For i = LBound(MyAr) To LBound(MyAr)
    '~~> This will give you the contents of your email
    '~~> on separate lines
    Debug.Print MyAr(i)
Next i

I hope this can give you some idea of what to do?

TESTED....but

if i have a lines in body similar:
AAAAAAAAAAAAAA BBBBBBBBBBB CCCCC DD
AAAAAAAAAAAAAA BBBBBBBBBBB CCCCC DD
AAAAAAAAAAAAAA BBBBBBBBBBB CCCCC DD

the code return Debug.Print MyAr(i)

AAAAAAAAAAAAAA
BBBBBBBBBBB
CCCCC
DD
AAAAAAAAAAAAAA
BBBBBBBBBBB
CCCCC
DD
AAAAAAAAAAAAAA
BBBBBBBBBBB
CCCCC
DD

i need to loop the lines exactlly wtah i see:

AAAAAAAAAAAAAA BBBBBBBBBBB CCCCC DD
AAAAAAAAAAAAAA BBBBBBBBBBB CCCCC DD
AAAAAAAAAAAAAA BBBBBBBBBBB CCCCC DD

[Rudi]

That is strange? There is nothing in the Split function to enforce splitting at spaces?
Does one of these make a difference?

MyAr = Split(olMail.body, vbLf)
or
MyAr = Split(olMail.body, vbCr)

[sal21]

That is strange? There is nothing in the Split function to enforce splitting at spaces?
Does one of these make a difference?

MyAr = Split(olMail.body, vbLf)
or
MyAr = Split(olMail.body, vbCr)

same effect in vertical!

I have tested also with vbnewline but same effect.
I can send the original email in pvt?

[Rudi]

Sure. I can attempt to resolve better with the source file.
I have sent you a PM with my email...

[Rudi]

In your email the data appears in a table. Is it also in a table structure in the email you receive?

[Rudi]

Hi Sal,

I am assuming (based on what you emailed me) that the data in your emails is in a table format.
If this is the case, here is code that will import the rows of data from a table in the body of an email into the active Excel sheet. I have modified it slightly from the original source found here, thanks to VBA Geek!
I have tested it and it works well.

Place this code below into your workbook and ensure that you modify email address of your email account and also the subfolder name. The macro will process ONLY the first email in your inbox. If the email containing the table is not the first email, you can move it into a subfolder you create. If you don't need the subfolder, just comment it out.
Note: If the email does NOT have a table, it will debug!

Code: Select all

Sub impOutlookTable()

' Change this CONST to point to the desired email
'==================================================
Const strMail As String = "your_email@domain.com"   '<<< Change email in this line!!
'==================================================

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")
    '=========================================================================
    'RECOMMENDED: This line will import from a subfolder in the Inbox
    'Comment it out if you don't need it.
    Set oMapi = oMapi.Folders("My_SubFolder") '<<< Modify the sub folder name
    '=========================================================================
    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
End Sub

[sal21]

Hi Sal,

I am assuming (based on what you emailed me) that the data in your emails is in a table format.
If this is the case, here is code that will import the rows of data from a table in the body of an email into the active Excel sheet. I have modified it slightly from the original source found here, thanks to VBA Geek!
I have tested it and it works well.

Place this code below into your workbook and ensure that you modify email address of your email account and also the subfolder name. The macro will process ONLY the first email in your inbox. If the email containing the table is not the first email, you can move it into a subfolder you create. If you don't need the subfolder, just comment it out.
Note: If the email does NOT have a table, it will debug!

Code: Select all

Sub impOutlookTable()

' Change this CONST to point to the desired email
'==================================================
Const strMail As String = "your_email@domain.com"   '<<< Change email in this line!!
'==================================================

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")
    '=========================================================================
    'RECOMMENDED: This line will import from a subfolder in the Inbox
    'Comment it out if you don't need it.
    Set oMapi = oMapi.Folders("My_SubFolder") '<<< Modify the sub folder name
    '=========================================================================
    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
End Sub

tks Rudi for code and patience, i cannot test now...

[sal21]

Hi Sal,

I am assuming (based on what you emailed me) that the data in your emails is in a table format.
If this is the case, here is code that will import the rows of data from a table in the body of an email into the active Excel sheet. I have modified it slightly from the original source found here, thanks to VBA Geek!
I have tested it and it works well.

Place this code below into your workbook and ensure that you modify email address of your email account and also the subfolder name. The macro will process ONLY the first email in your inbox. If the email containing the table is not the first email, you can move it into a subfolder you create. If you don't need the subfolder, just comment it out.
Note: If the email does NOT have a table, it will debug!

Code: Select all

Sub impOutlookTable()

' Change this CONST to point to the desired email
'==================================================
Const strMail As String = "your_email@domain.com"   '<<< Change email in this line!!
'==================================================

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")
    '=========================================================================
    'RECOMMENDED: This line will import from a subfolder in the Inbox
    'Comment it out if you don't need it.
    Set oMapi = oMapi.Folders("My_SubFolder") '<<< Modify the sub folder name
    '=========================================================================
    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
End Sub

Rudi! the code work great!!!!!!!!!!!!!!
Tks.

Only a prob.
In the email folder i have not one email but variuos, and i loop with:

For Each olItm In olFld.Items
'your code
next

naturally the second values of email overwrite the existsing values in cells! beacuse the for next start always from the first row...
Peraphs i need to increase +1 a variable in your loop?

[Rudi]

Hi,

Replace the looping part with this new structure...

Code: Select all

    'import in Excel
    Dim x As Long, y As Long
    Dim i As Long
    i = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    For x = 0 To oElColl(0).Rows.Length - 1
        For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
            Range("A" & i).Offset(x, y).Value = oElColl(0).Rows(x).Cells(y).innerText
        Next y
    Next x

[Rudi]

Here is another version that does not duplicate column headings for each new table that is imported (assuming that your tables all have column headings)

Code: Select all

    'import first block with column headers in Excel
    Dim x As Long, y As Long
    Dim i As Long
    i = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    If i = 2 Then
        For x = 0 To oElColl(0).Rows.Length - 1
            For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
                Range("A" & i).Offset(x, y).Value = oElColl(0).Rows(x).Cells(y).innerText
            Next y
        Next x
    Else
        'import all other blocks without column headers in Excel
        i = Range("A" & Rows.Count).End(xlUp).Row
        For x = 1 To oElColl(0).Rows.Length - 1
            For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
                Range("A" & i).Offset(x, y).Value = oElColl(0).Rows(x).Cells(y).innerText
            Next y
        Next x
    End If

[sal21]

Hi,

Replace the looping part with this new structure...

Code: Select all

    'import in Excel
    Dim x As Long, y As Long
    Dim i As Long
    i = Range("A" & Rows.Count).End(xlUp).Offset(1).Row
    For x = 0 To oElColl(0).Rows.Length - 1
        For y = 0 To oElColl(0).Rows(x).Cells.Length - 1
            Range("A" & i).Offset(x, y).Value = oElColl(0).Rows(x).Cells(y).innerText
        Next y
    Next x

SUPER!!!!
tks Rudi