looping trough text in tables from email and save to Access database

[megatronixs]

Hi all,

I created some code to read emails from Outlook and put text from a table in the email to the Access database.
Now I need to capture the participants from the email and create for each a new entry in the database.
It would need to go one by one of the participants name and add themm to the table.
In the table that is in the emails, it has 2 columns and 7 rows
first is for the Event ID, and the other 6 for the participants.

Private Sub btn_process_enrolment_emails_Click()
'//--------- Dim and Set------------------------
Dim TempRst         As DAO.Recordset
Dim rst             As DAO.Recordset
Dim db              As DAO.Database
Dim vText           As Variant
Dim sText           As String
Dim i               As Long, j As Long
Dim rCount          As Long
Dim strParameter    As String
Dim strParamValue   As String
Dim oItem           As MailItem
Dim olApp           As Outlook.Application
Dim objNS           As Outlook.NameSpace
Dim olFolder        As Outlook.MAPIFolder
Set db = CurrentDb
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set olFolder = olFolder.Folders("Training Team Enrolment")
Set TempRst = CurrentDb.OpenRecordset("tbl_enrolment")
 
For Each InboxItem In olFolder.Items
If InboxItem.Subject Like "RE: Training:*" Then
    If InboxItem.UnRead Then
    With TempRst
        .AddNew
sText = InboxItem.Body
vText = Split(sText, Chr(13))

For i = UBound(vText) To 0 Step -1
    
    vItem = Split(vText(i), Chr(9))
    
    strParameter = ""
    strParamValue = ""
 On Error Resume Next
    strParameter = Trim(Replace(vItem(0), Chr(10), ""))
    strParamValue = Trim(vItem(1))

    Select Case strParameter
        Case "Event ID:"
            !event_id = strParamValue
        Case "Participant 1:"
            !participant_name = strParamValue
'        Case "Participant 2:"
'
'            !participant_name = strParamValue
'
'        Case "Participant 3:"
'
'            !participant_name = strParamValue
'
'        Case "Participant 4:"
'
'            !participant_name = strParamValue
'
'        Case "Participant 5:"
'
'            !participant_name = strParamValue
'
'        Case "Participant 6:"
'
'            !training_duration = strParamValue
    End Select
    
Next i
 .Update
 InboxItem.UnRead = False
 InboxItem.FlagStatus = olFlagComplete
End With
End If
 
Set TempRst = Nothing
End If
Next
End Sub

Any help on this?

Greetings.

 

[sneuberg]

If you want help on this I suggest first telling us what sort of help you want. If you want some general suggestions on how to parse these email bodies then you should post what the format of the email body is and what can be counted on in the format.

 

[megatronixs]

Hi sneuberg,

Thanks for your comments.
The format of the email is HTML. at the bottom there is a table with 2 columns and 7 rows.
The code is created like this in another automation:

Private Sub btn_enrol_email_Click()
Dim objItem As Object
Dim db As DAO.Database
Dim MailList As DAO.Recordset
Dim oMail As Outlook.MailItem
Dim oApp As Object
'Dim create_event_table As Recordset
 
'Set create_event_table = CurrentDb.OpenRecordset("tbl_create_event")
Set oMail = objItem
Set oApp = CreateObject("Outlook.application")
Set oMail = oApp.CreateItem(olMailItem)
Set db = CurrentDb()
Set MailList = db.OpenRecordset("MyEmailAddresses")
 
'' Now, we open Outlook for our own device..
'Set MyOutlook = New Outlook.Application
 
' Set up the database and query connections
 
 
' this is where we loop through our list of addresses,
' adding them to e-mails and sending them.
 
Do Until MailList.EOF
 
' This creates the e-mail
' We need to move it BEFORE we start the loop, since
' we don't want to make a bunch of e-mails, we just want one.
 
'Set MyMail = MyOutlook.CreateItem(olMailItem)
' this is where we loop through our list of addresses,
' and we add them to the RECIPIENTS collection
 
Do Until MailList.EOF
 
' This adds the address to the list of recipients
oMail.Recipients.Add MailList("email")
 
'And on to the next one...
MailList.MoveNext
 
Loop
'And now that we've addressed it, we can finish composing the rest of the fields.
 
'This gives it a subject, sent on behalf of
oMail.Subject = "Training: " & Me.training_name_text
oMail.SentOnBehalfOfName = "on behalf from"
 
' 'This gives it the body
' MyMail.Body = Me.body_text
 
 
'This gives it the body
oMail.HTMLBody = "<HTML><HEAD><Font Size= 2><style> table, th, td </style> </HEAD> <BODY><br><p>" & _
"Dear reader,</p>" & _
"Please be aware that this is an email to inform you about new training comming up.</p>" & _
"Please forward this to the ones that could be interested in the training.<p>" & _
"To assist with this requirement, can you please confirm if you need some help</p><br><br><p>" & _
"<b><font size=""2"" face=""Arial"" color=""red"">If business unit or location has changed please let us know.</font><b/></p>" & _
"<TABLE><TR><TD>Event ID:</TD><TD>" & Me.event_id_2_text & "</TD></TR><TR>" & _
"<TD>Participant 1:</TD><TD>enter text</TD></TR><TR>" & _
"<TD>Participant 2:</TD><TD>enter text</TD></TR><TR>" & _
"<TD>Participant 3:</TD><TD>enter text</TD></TR><TR>" & _
"<TD>Participant 4:</TD><TD>enter text</TD></TR><TR>" & _
"<TD>Participant 5:</TD><TD>enter text</TD></TR><TR>" & _
"<TD>Participant 6:</TD><TD>enter text</TD></TR><TR><TD><TD></TD></TABLE> </BODY> </HTML>"
 
'This displays it!
oMail.Display
 
Loop
 
'Cleanup after ourselves
Set oApp = Nothing
Set MyOutlook = Nothing
 
MailList.Close
Set MailList = Nothing
db.Close
Set db = Nothing
 
End Sub]

What I want to do, is, add each participant to the database, one by one each on a new record.

Greetings.

 

[sneuberg]

The format of the email is HTML. at the bottom there is a table with 2 columns and 7 rows.

An HTML table? If that's the case you might be able to just use the HTML tags <TD>, </TD> to extract the data if you can extract the table. I suggest you post a sample of the HTML email body (in HTML format).

The code is created like this in another automation:

Please clarify this statement. This code doesn't seem to be parsing an HTML formatted email. So how does it related to you problem? What parts of it are relevant?

 

[megatronixs]

Hi,
the code used to extract the text from the email is in the first post.

This is the HTML table from the email:

Event ID:24Participant 1: John July Participant 2: Peter Cetera Participant 3: Mister X Participant 4: John Bad Jovi Participant 5: Lukas Snow Participant 6: Claudia von Dam

I hope the HTML will be still visible.
Greetings.

 

[sneuberg]

Since this involves parsing an HTML document over which you have control I believe the best approach (at least most elegant) would be to use the Microsoft XML parser. But as I've never used it myself it maybe a while before I can give you something specific.

 

[sneuberg]

Just an update. For the last 20 years I been living under the illusion that HTML was just subset or implementation of XML. This doesn't seem to be the case. In any case I can't get the XML parser to load an HTML document; at least not with the attributes.

Still I believe there has to be a way to take advantage of the HTML format rather the just doing this brute force with Split and InStr. I'm now look into the MSHTML library as they talk about here.

 

[megatronixs]

Hi,

It is reall a pain to work with the code I have.
I managed to make it create a record for each participant, but I can't get it to add also on the same time the Event ID.

Maybe a custom outlook form would do the trick. People would fill in the fields there and submit. then I would process the email with the automation.

Do you have any idea if that would be possible?

Greetings and many thanks for your comments.

 

[sneuberg]

I'm making process now. The code below is your code simplified and with the part in blue added. It works and outputs the text for Participant 1:. You might note that in this code work uses the InboxItem.HTMLBody rather than the InboxItem.Body as your code did.

Getting to the Participant 1 text by referring to the 3rd item in the collection isn't ideal. I believe you can assign ids to the TD elements and retrieve them with getElementById. If not that maybe with getElementsByClassName. I want to work on this and also this code doesn't work with early binding. It doesn't like open.Write. I hoping I can find a workaround for this but if not I'd just use it with late binding. I'll try to get you something tomorrow.

Private Sub btn_process_enrolment_emails_Click()
'//--------- Dim and Set------------------------
Dim TempRst         As DAO.Recordset
Dim rst             As DAO.Recordset
Dim db              As DAO.Database
Dim vText           As Variant
Dim sText           As String
Dim i               As Long, j As Long
Dim rCount          As Long
Dim strParameter    As String
Dim strParamValue   As String
Dim oItem           As MailItem
Dim olApp           As Outlook.Application
Dim objNS           As Outlook.NameSpace
Dim olFolder        As Outlook.MAPIFolder
Dim InboxItem       As Outlook.MailItem     'Added
Dim vItem           As Variant              'Added

Set db = CurrentDb
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)
Set TempRst = CurrentDb.OpenRecordset("tbl_enrolment")
 
For Each InboxItem In olFolder.Items
    If InboxItem.Subject Like "RE: Training:*" Then
       [COLOR="Blue"] Dim oDoc As Object
        Set oDoc = CreateObject("htmlfile") '// late binding
        oDoc.Open
        oDoc.Write InboxItem.HTMLBody
        oDoc.Close
        Debug.Print oDoc.getElementsByTagName("TD").Item(3).innerText[/COLOR]
    End If
Next InboxItem
End Sub

 

[megatronixs]

Hi,

It looks great and works nice
I guess I can make my loop work when I have the Event ID in the subject, Dim it as a String and then add this with every loop to the table. The email subject has to be similar everytime and this will solve it (I hope).

Greetings.

 

[sneuberg]

With the help of this thread I solved the oDoc.write problem so it's just a matter of putting together the pieces for you. I should have some options for you by the end of the day.

As an aside I think it's a shame that you can't just email a form to a person. I don't think you can do it that way as I've never seen it done. Typically the way your problem is solved is with an email with a link to a Web site where you fill in a form. So if you have a Web site with MYSQL you could put a page on the site to collect this information and then connect you Access database to the MYSQL table through an ODBC connection.

 

[sneuberg]

I have a question about your code, specifically

Case "Participant 6:"

            !training_duration = strParamValue

This implies the information for Participant 6 goes in another field named training_duration. Was this an error? Do you want to collect information on the training duration?

 

[megatronixs]

Hi,
It was an error, should have been "participant_name"
a typo in plain view :-(

Greetings.

 

[sneuberg]

This is option 1. I'm still working on option 2 which will be my attempt at doing this using the id attribute which I think would make this more robust. I can't take any credit for this an this is just an adaptation of the code I found in the web page I referenced earlier. The main code for this is

Sub ExtractParticipants(InboxItem As Outlook.MailItem)

Dim EmailHTML As MSHTML.HTMLDocument
Dim oElColl As MSHTML.IHTMLElementCollection
Dim Row As Long
Dim EventID As String
Set EmailHTML = New MSHTML.HTMLDocument
Set oElColl = EmailHTML.getElementsByTagName("table")
EmailHTML.Body.innerHTML = InboxItem.HTMLBody
EventID = oElColl(0).rows(0).cells(1).innerText
For Row = 1 To oElColl(0).rows.length - 1
    If oElColl(0).rows(Row).cells(1).innerText <> vbNullString And oElColl(0).rows(Row).cells(1).innerText <> "enter text" Then
        CurrentDb.Execute "INSERT INTO tbl_enrolment (event_id,participant_name) Values( '" & EventID & "','" & oElColl(0).rows(Row).cells(1).innerText & "')"
    End If
Next Row

End Sub

This extracts the EventID and then just loops through the HTML table inserting the Event ID and the participants names into the tbl_enrolment table. This subroutine is called by this code

Private Sub btn_process_enrolment_emails_Click()
Dim olApp           As Outlook.Application
Dim objNS           As Outlook.NameSpace
Dim olFolder        As Outlook.MAPIFolder
Dim InboxItem       As Outlook.MailItem     'Added
Set olApp = Outlook.Application
Set objNS = olApp.GetNamespace("MAPI")
Set olFolder = objNS.GetDefaultFolder(olFolderInbox)

For Each InboxItem In olFolder.Items
    If InboxItem.Subject Like "RE: Training:*" Then
        ExtractParticipants InboxItem
    End If
Next InboxItem
End Sub

which is your code simplified for testing. It processes the any email in your inbox with "Re Training" in the subject. You can see this work in the attached database.

Edit: This code needs some clean up, i.e., setting the objects to nothing.

 

[megatronixs]

WOOOW, impressive

Thanks a lot this, I tested and it worked so great
Once I have finished the whole thing, I will post the code so others can make use of it too.

Greetings.

 

[sneuberg]

I forgot to tell you that this code requires the Microsoft HTML Object Library reference so if you incorporate this into your code you will need to add that reference or rewrite the code for late binding.

 

[sneuberg]

Here's Option 2. In this version the original email is changed so the the table elements have ids as shown in red below:

"<TABLE><TR><TD>Event ID:</TD><TD [COLOR="Red"] id='eventid'[/COLOR] >" & Me.event_id_2_text & "</TD></TR><TR>" & _
"<TD>Participant 1:</TD><TD [COLOR="red"]id='p1[/COLOR]' >enter text</TD></TR><TR>" & _
"<TD>Participant 2:</TD><TD [COLOR="red"]id='p2[/COLOR]' >enter text</TD></TR><TR>" & _
"<TD>Participant 3:</TD><TD[COLOR="red"] id='p3[/COLOR]' >enter text</TD></TR><TR>" & _
"<TD>Participant 4:</TD><TD [COLOR="red"]id='p4'[/COLOR] >enter text</TD></TR><TR>" & _
"<TD>Participant 5:</TD><TD [COLOR="red"]id='p5'[/COLOR] >enter text</TD></TR><TR>" & _
"<TD>Participant 6:</TD><TD [COLOR="red"]id='p6'[/COLOR] >enter text</TD></TR><TR><TD><TD></TD></TABLE> </BODY> </HTML>"

and the data is extracted using getElementById as shown in the code below

Sub ExtractParticipants(InboxItem As Outlook.MailItem)
On Error GoTo ExtractParticipants_Err

Dim EmailHTML As MSHTML.HTMLDocument
Dim i As Long
Dim NumberOfParticipants
Dim EventID As String
Dim Participant As String
Set EmailHTML = New MSHTML.HTMLDocument
EmailHTML.Body.innerHTML = InboxItem.HTMLBody
EventID = EmailHTML.getElementById("eventid").innerText
NumberOfParticipants = 6 'Set this equal to the number of participants
For i = 1 To NumberOfParticipants
    Participant = EmailHTML.getElementById("p" & i).innerText 'concatenate i to "p" to get p1, p2, etc
    If Participant <> " " And Participant <> vbNullString And Participant <> "enter text" Then
        CurrentDb.Execute "INSERT INTO tbl_enrolment (event_id,participant_name) Values( '" & EventID & "','" & Participant & "')"
    End If
Next i
EmailHTML.Close
Set EmailHTML = Nothing

ExtractParticipants_Exit:
    Exit Sub

ExtractParticipants_Err:
    If Err.Number = 91 Then
        MsgBox "The email table is missing something"
         Resume ExtractParticipants_Exit
    Else
        MsgBox Error$
        Resume ExtractParticipants_Exit
    End If
End Sub

If any of the ids are missing in the email table error 91 is raised which is trapped so that if for example you got an email back where the table had been deleted this would let you know. Actually I never got around to testing that in the previous version I post but I suspect that will raise this error too if the entire table is missing so if you decide to go with that version you should check that.

A database with this version is attached.

 

[megatronixs]

HI,

Is it possible to create the email with the amount of participants according the amount of places available? If I have 12 spaces available for a training, clicking on the button it will create 12 lines instead of the now 6 lines:

"<TD>Participant 1:</TD><TD [COLOR=red]id='p1[/COLOR]' >enter text</TD></TR><TR>" & _

the below line of code gives me the number of available spaces:

strEventID_ = DLookup("[avaialble_spaces]", "tbl_create_event", "[event_id] = " & EventID & "")

Greetings.

 

[sneuberg]

You could have a for loop create the rows for you something like:

For i = 1 To AvailableSpaces
    strHTMLBody = strHTMLBody & "<TR><TD>Participant " & i & ":</TD><TD id='p" & i & "' >enter text</TD></TR>"
Next i

You can find the other details about this in the btn_enrol_email_Click code in the attached database. I think you might need to change the ExtractParticipants code to get the number of participants from the table. The last version of this code that I saw (also in attached db) has the number fixed at 6.

 

[megatronixs]

OK, I got it working

Thanks a lot.

Greetings.