Forum Discussion

GeoKoro13's avatar
GeoKoro13
Copper Contributor
Mar 26, 2021

Excel VBA - Import Table from Email

I'm trying to use this code on Excel from an forum to extract a table from an email and import it to Excel. However, I'm not experience with coding so, I would like some help with the following.

Weekly, I'm receiving emails from two sources with a specific subject ("Source" & # & "Pipeline Schedule -" & "Date()") but different to each other. Source1 send the table on its body and in a PDF format where Source2 send either one or two table only on its body.

Using the answer from the aforementioned post, I'm able to copy the whole body but unfortunately it paste it in one cell (can't figure out why, beside the suggestion there). However, in my case I only need the tables.

See the code below

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, "Source1 Pipeline Schedule - 24 Mar 2021") > 0 Then ' That's just the subject of the latest email I used to test the code.
ThisWorkbook.Sheets("Sheet1").Cells(i, 1).Value = olMail.Body
i = i + 2
End If
Next olMail

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

End Sub

 

I lack a lot of VBA experience so excuse me in advance if I'm missing something.

Cheers

excel
Macros and VBA

1 Reply

  • GeoKoro13's avatar
    GeoKoro13
    Copper Contributor
    Mar 26, 2021

    GeoKoro13 

     

    So, I managed to combine some codes and import tables from Outlook (see updated code below). However, on one of the Supplier, it also copy the images from the email signature. Can we avoid that? 2nd issue is that the tables are not pasted on the 1st Row so, for me with hard to manipulate the data automatically. Any ideas? 3rd issue, some of this email have a trail of correspondence with "draft" plans. Can somehow stop reading the email body once it reach the end of the current correspond?

     

    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
Dim xTable As Word.Table
Dim xDoc As Word.document
Dim xRow As Integer

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

olItms.Sort "Subject"

i = 1
On Error Resume Next

xRow = 1
For Each olMail In olItms
    If InStr(1, olMail.Subject, "Supplier 2 Pipeline Schedule - 26 Mar 2021") > 0 Then
    Set xDoc = olMail.GetInspector.WordEditor
    For i = 1 To xDoc.Tables.Count
        Set xTable = xDoc.Tables(i)
        xTable.Range.Copy
        ThisWorkbook.Sheets("Sheet2").Paste
        xRow = xRow + xTable.Rows.Count + 1
        ThisWorkbook.Sheets("Sheet2").Range("A" & CStr(xRow)).Select
    Next
    End If
Next olMail
    
Set olFldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
    
End Sub

Resources