Read email content and save the data down in database (1 Viewer)

Derek

Registered User.
Local time
Today, 14:10
Joined
May 4, 2010
Messages
214
Hi guys,

We got a request from client to built something that can read data from email attachment and save the data down in the database .

Can you please shed any light on this ? How this can be achieved ?

Thanks
 

theDBguy

I’m here to help
Local time
Today, 14:10
Joined
Oct 29, 2018
Messages
10,106
Hi Derek. Do they use Outlook as an email client? What kind of email attachments are we talking about reading for data?
 

Derek

Registered User.
Local time
Today, 14:10
Joined
May 4, 2010
Messages
214
Hi, sorry the body of the email stores all the details like .. Customer Name, contact number , Address etc... The data in the email is structured in table.
 

The_Doc_Man

Happy Retired Curmudgeon
Local time
Today, 16:10
Joined
Feb 28, 2001
Messages
16,796
If the body contains the data, then you have to read the body. But the next question is, what is the format in this case? Are you allowing HTML bodies in, or are you looking at a secure environment where all you can get would be text? The question from theDBguy is highly relevant. In Outlook you can grab a mail object from the inbox and look at it's properties, one of which is .Body - the body of the message. Your answer would be there if that is what you are using.

There are threads here that discuss processing of HTML input, but without knowing a little more of what is going on, I don't know how to offer any more help than that.
 

CJ_London

Super Moderator
Staff member
Local time
Today, 22:10
Joined
Feb 19, 2013
Messages
12,092
if the email is 'structured as a table' then I suspect it will be html
 

theDBguy

I’m here to help
Local time
Today, 14:10
Joined
Oct 29, 2018
Messages
10,106
Hi, sorry the body of the email stores all the details like .. Customer Name, contact number , Address etc... The data in the email is structured in table.
So, to make sure I understand. Are you saying you misspoke earlier and instead of reading "attachments," you actually meant you want to read the "body" of the email? Is that correct?
 

Cronk

Registered User.
Local time
Tomorrow, 07:10
Joined
Jul 4, 2013
Messages
2,351
I've created several applications over the years for clients involving importing data in emails to Access. In all of them, the mail client was Outlook.

The first thing that needs to be determined is how you determine which emails contain the data. Will you have a dedicated email account having only these emails? First step, easy. If the target emails are mixed with other messages, how are you going to select the ones for processing? Is there something in the subject heading that can provide a basis for filtering or will you present a display of all emails in the InBox for the user to choose which emails are to be processed?

In all my cases, I either had a dedicated mail account or the subject had something unique such as daily emails being received with the subject "Production Data for March 1 2020". So I filtered out only those mails that had the leading text in the subject.

The data import process was normally initiated by a user clicking an Import button in Access. Using automation, the db would loop through all mail messages in the InBox, If the data was in the body, the message would be stored in a variable, the mail item would then be moved to another folder so as not to be re-processed.

Then I used code to parse the variable containing the string to extract the data, with appropriate checks that the data format and data elements were consistent.
 

Derek

Registered User.
Local time
Today, 14:10
Joined
May 4, 2010
Messages
214
Hi guy,

I want to read the email body contents and also there is change of requirement so I need outlook vba code so the extract will create a .txt file per email rather than collate and .txt files need to be saved down in a particular folder on network.

Can anyone please help me in this ?

Thanks
 

Derek

Registered User.
Local time
Today, 14:10
Joined
May 4, 2010
Messages
214
Please see below my code so far. I just need to figure out how the data can be displayed in pipe delimited format in text file. At the moment it is showing each text in new line which is not quite right .

Code:
Sub Extract()
    On Error Resume Next
    Set myOlApp = Outlook.Application
    Set mynamespace = myOlApp.GetNamespace("mapi")
    
    Dim objFS As New Scripting.FileSystemObject
    Dim objFile As Scripting.TextStream
    
    'open the current folder

    Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
    
   
    For I = 1 To myfolder.Items.Count
    
    Set myitem = myfolder.Items(I)
    
    msgtext = myitem.Body
        
    'search for specific text
    
    delimtedMessage = Replace(msgtext, "Name", "###")
    delimtedMessage = Replace(delimtedMessage, "Contact Number", "###")
    delimtedMessage = Replace(delimtedMessage, "Address", "###")
    delimtedMessage = Replace(delimtedMessage, "Email", "###")
    delimtedMessage = Replace(delimtedMessage, "Gender", "###")
    
    messageArray = Split(delimtedMessage, "###")
        
   Set objFile = objFS.CreateTextFile("C:\ABC\a.txt", False)
   
   With objFile
   
    .Write messageArray(1) & "|" & messageArray(2) & "|"
    .Write messageArray(3) & "|"
    .Write messageArray(4) & "|"
    .Write messageArray(5) & "|"
    
  End With
  
    Next
    objFile.Close
    End Sub
 

Cronk

Registered User.
Local time
Tomorrow, 07:10
Joined
Jul 4, 2013
Messages
2,351
Is that because you concatenate messageArray(1) and (2) but not (3) to (5)?

BTW in the loop, there is no change in the text file name.
 

Derek

Registered User.
Local time
Today, 14:10
Joined
May 4, 2010
Messages
214
Cronk, The code doesn't truncate blank spaces and that's why data is not showing in one line . Please see attached my text file and updated code below:
Code:
Sub Extract()
    
    On Error Resume Next
    
    Set myOlApp = Outlook.Application
    Set mynamespace = myOlApp.GetNamespace("mapi")
    
    Dim objFS As New Scripting.FileSystemObject
    Dim objFile As Scripting.TextStream
    Dim FilePath As String
    Dim sFilePath As String
    Dim fileNumber As Integer
    Dim strRowData As String
    Dim strDelimiter As String
    Dim j As Integer
    
    strRowData = ""
        
    Set myfolder = myOlApp.ActiveExplorer.CurrentFolder
    
    For I = 1 To myfolder.Items.Count
    
    messageArray = ""
    strRowData = ""
    
    Set myitem = myfolder.Items(I)
    
    msgtext = Trim(myitem.Body)
          
    'search for specific text
    
    delimtedMessage = Replace(Trim(msgtext), "Name", "###")
    delimtedMessage = Replace(Trim(delimtedMessage), "Account Number", "###")
    delimtedMessage = Replace(Trim(delimtedMessage), "Address", "###")
    delimtedMessage = Replace(delimtedMessage, "Telephone Number", "###")
    delimtedMessage = Replace(delimtedMessage, "DOB", "###")
    delimtedMessage = Replace(delimtedMessage, "University", "###")
    delimtedMessage = Replace(delimtedMessage, "SUbjects", "###")
    delimtedMessage = Replace(delimtedMessage, "Birth Place", "###")
    delimtedMessage = Replace(delimtedMessage, "SCore", "###")
    delimtedMessage = Replace(delimtedMessage, "Outcome", "###")
    delimtedMessage = Replace(delimtedMessage, "References", "###")
    
    messageArray = Split(delimtedMessage, "###")
    

    For j = 1 To 11
    
    strRowData = Trim(strRowData & Trim(messageArray(j)) & "|")
    
    Next j
    
    MsgBox strRowData
    sFilePath = "C:\a" & Format(Now, "ddmmyyyyhhmmss") & ".txt"
        
    Set objFile = objFS.CreateTextFile(sFilePath, False)
   
   
   With objFile
      .WriteLine strRowData
   End With
      
    Next I
    objFile.Close
    End Sub
 

Attachments

Cronk

Registered User.
Local time
Tomorrow, 07:10
Joined
Jul 4, 2013
Messages
2,351
If your email body contains carriage returns that would give you carriage returns in the output string. Try replacing all occurrences of chr(13) and chr(10) with null strings in msgtext
 

Derek

Registered User.
Local time
Today, 14:10
Joined
May 4, 2010
Messages
214
Thanks Cronk , can you please let me know exactly where I need to make the change ? Can you please update the code for me ?
Thanks
 

arnelgp

error reading drive A:
Local time
Tomorrow, 05:10
Joined
May 7, 2009
Messages
9,293
haven't tested this
Code:
Sub Extract()

On Error Resume Next

Set myOlApp = Outlook.Application
Set mynamespace = myOlApp.GetNamespace("mapi")

Dim objFS As New Scripting.FileSystemObject
Dim objFile As Scripting.TextStream
Dim FilePath As String
Dim sFilePath As String
Dim fileNumber As Integer
Dim strRowData As String
Dim strDelimiter As String
Dim j As Integer

strRowData = ""

Set myfolder = myOlApp.ActiveExplorer.CurrentFolder

    sFilePath = "C:\a" & Format(Now, "ddmmyyyyhhmmss") & ".txt"
    For i = 1 To myfolder.Items.Count

messageArray = ""
strRowData = ""

Set myitem = myfolder.Items(i)

msgtext = Trim(myitem.Body)

'search for specific text

delimtedMessage = Replace(Trim(msgtext), "Name", "###")
delimtedMessage = Replace(Trim(delimtedMessage), "Account Number", "###")
delimtedMessage = Replace(Trim(delimtedMessage), "Address", "###")
delimtedMessage = Replace(delimtedMessage, "Telephone Number", "###")
delimtedMessage = Replace(delimtedMessage, "DOB", "###")
delimtedMessage = Replace(delimtedMessage, "University", "###")
delimtedMessage = Replace(delimtedMessage, "SUbjects", "###")
delimtedMessage = Replace(delimtedMessage, "Birth Place", "###")
delimtedMessage = Replace(delimtedMessage, "SCore", "###")
delimtedMessage = Replace(delimtedMessage, "Outcome", "###")
delimtedMessage = Replace(delimtedMessage, "References", "###")

messageArray = Split(delimtedMessage, "###")
   
        For j = 1 To 11

strRowData = strRowData & Replace(Replace(Trim(strRowData & Trim(messageArray(j)) & "|"), vbCr, ""), vbLf, "")

Next j

MsgBox strRowData

If i = 1 Then
' create the file on first run
Set objFile = objFS.CreateTextFile(sFilePath, False)

Else
' open text file on succeeding files
Set objFile = objFS.OpenTextFile(sFilePath, ForAppending)

End If


With objFile
.WriteLine strRowData
End With


objFile.Close

Next i

End Sub
 

Derek

Registered User.
Local time
Today, 14:10
Joined
May 4, 2010
Messages
214
Hi Arnelgp, Please see attached the text file. It's now showing all the values duplicating multiple times .
 

Attachments

Derek

Registered User.
Local time
Today, 14:10
Joined
May 4, 2010
Messages
214
Thanks so much Arnelgp. It actually worked. I had to delete extra concatenation bit as below and it works like a charm.
Code:
strRowData = Replace(Replace(Trim(strRowData & Trim(messageArray(j)) & "|"), vbCr, ""), vbLf, "")
 

Derek

Registered User.
Local time
Today, 14:10
Joined
May 4, 2010
Messages
214
Guys, one more question . Presently when the VBA script is run then it looks into the folder you are currently in and then extract data from that folder . How can I amend the code as below :
1. so it will look into a specific email folder and extract emails from that particular folder only.
2. After extraction move the email to complete folder so that the same email is not extracted more than once .

Thanks
 

Users Who Are Viewing This Thread (Users: 0, Guests: 1)

Top Bottom