Parsing Email Body to Microsoft Access

I  would like some help with creating a way for Outlook to check for subject "Move in a Resident"  coming into a particular email address, then parsing the email body data and populating into an access database table. Below is how the body of the email is formatted.

The subject will always be "Move in a Resident"

Applicant Details:
-- Doe, John D  SSN: 000000000

Rent Amount: $700.00
Move In Date: 08/03/2013

Address: 3701 Cimarron Blvd Corpus, Christi, TX 78414

The fields in Microsoft Access Database "Move In" Table "Move In"are
Name
SSN
MoveInAddress
Rent
MoveInDate


All help will be appreciated. I am using Access and Outlook 2013
cskehanAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Boyd (HiTechCoach) Trimmell, Microsoft Access MVPDesigner and DeveloperCommented:
0
cskehanAuthor Commented:
Not quite but close now I am using outlook and access 2013 and I reworded a little.

Here is my code so far I have it going to Excel for right now just for testing purposes. I have copied this code from someone else.  My problem. is that the name and SSN are going into the same field "SSN" and address isn't parsing at all.  Rent amount and move in date are working correctly.  Please help I am VBA impaired especially when it comes to outlook.

Sub CaptureData(MyMail As MailItem)
    Dim SenderName As String, SentTime As String, MailBody As String, strFileName As String
    Dim MyArray() As String, SSN As String, RentAmount As String
    Dim strTemp() As String, MoveInDate As String, Address As String
    
    Dim LastRow As Long
    Dim oXLApp As Excel.Application
    Dim oXLBook As Excel.Workbook
    Dim oXLSheet As Excel.Worksheet
    
    On Error GoTo Whoa
    
    '~~>  Change File Applicant Details Here
    strFileName = "C:\Users\CFO.NVART\Documents\Data1.xls"
    
    '~~> Extraction of Details
    strID = MyMail.EntryID
    MailBody = MyMail.Body
    
    MyArray = Split(MailBody, vbNewLine)
    For i = LBound(MyArray) To UBound(MyArray)
        'Applicant Details:
        If InStr(1, MyArray(i), "Applicant Details:", vbTextCompare) Then
            strTemp = Split(MyArray(i), "Applicant Details:")
            SenderName = Trim(strTemp(1))
        End If
        
        'SSN
        If InStr(1, MyArray(i), "SSN:", vbTextCompare) Then
            strTemp = Split(MyArray(i), "SSN:")
            SSN = Trim(Replace(MyArray(i), "SSN:", ""))
        End If
        
        'Rent Amount
        If InStr(1, MyArray(i), "Rent Amount:", vbTextCompare) Then
            strTemp = Split(MyArray(i), "Rent Amount:")
            RentAmount = Trim(Replace(MyArray(i), "Rent Amount:", ""))
        End If
        
        'Move in Date:
        If InStr(1, MyArray(i), "Move in Date:", vbTextCompare) Then
            strTemp = Split(MyArray(i), "Move in Date:")
            MoveInDate = Trim(Replace(MyArray(i), "Move in Date:", ""))
        End If

        'Address:
        If InStr(1, MyArray(i), "Address:", vbTextCompare) Then
            strTemp = Split(MyArray(i), "Address:")
            Address = Trim(Replace(MyArray(i), "Address:", ""))
        End If
    Next i
    
    '~~> Create a new instance of Excel
    Set oXLApp = New Excel.Application
    '~~> Open Excel File
    Set oXLBook = oXLApp.Workbooks.Open(strFileName)
    '~~> Work with First Workbook
    Set oXLSheet = oXLBook.Worksheets(1)
    oXLApp.Visible = False
    oXLApp.DisplayAlerts = False
    oXLApp.ScreenUpdating = False
    
    LastRow = oXLSheet.Range("A" & oXLApp.Rows.Count).End(xlUp).Row + 1
    
    '~~> Index Number
    oXLSheet.Range("A" & LastRow) = SenderName
    oXLSheet.Range("B" & LastRow) = SSN
    oXLSheet.Range("C" & LastRow) = RentAmount
    oXLSheet.Range("D" & LastRow) = MoveInDate
    oXLSheet.Range("E" & LastRow) = Address
    
LetsContinue:
    oXLApp.DisplayAlerts = True
    oXLApp.ScreenUpdating = True
    
    '~~> Close and save
    oXLBook.Close savechanges:=True
    
    '~~> CLEANUP (VERY IMPROTANT)
    Set oXLSheet = Nothing
    Set oXLBook = Nothing
    oXLApp.Quit
    Set oXLApp = Nothing
    Exit Sub
Whoa:
    MsgBox Err.Description
    Resume LetsContinue
End Sub

Open in new window

0
Jeffrey CoachmanMIS LiasonCommented:
<This is an exact  duplicate of this: http://www.experts-exchange.com/Programming/Languages/Visual_Basic/VB_Script/Q_28221319.html>

<Not quite but close now I am using outlook and access 2013 and I reworded a little. >
...
Then why not close that question first...?
Then post the working code here...
0
Newly released Acronis True Image 2019

In announcing the release of the 15th Anniversary Edition of Acronis True Image 2019, the company revealed that its artificial intelligence-based anti-ransomware technology – stopped more than 200,000 ransomware attacks on 150,000 customers last year.

cskehanAuthor Commented:
I tried closing the first post here. Sorry.
0
cskehanAuthor Commented:
So this is all I am going to get is a scolding because I posted it twice. What more than sorry would you like so that I can get some help here.
0
Jeffrey CoachmanMIS LiasonCommented:
No scolding...

It's just that it confuses the experts and we don't know what question to reply to...

But as far as your question is concerned, ...what you are asking here can be done, but it is not easy, especially for someone new to VBA coding.

But there may be some good news here...
;-)
If you are using Access 2007 or higher you can use the "Email Data Collection" feature to get this data into Access directly.
No code needed at all.

See here for more info:
http://office.microsoft.com/en-us/access-help/demo-collect-data-in-access-2007-by-using-e-mail-HA010252713.aspx
...and here:
http://office.microsoft.com/en-us/access-help/collect-data-by-using-e-mail-messages-HA010015427.aspx

There are other videos on Youtube as well...
;-)

JeffCoachman
0
cskehanAuthor Commented:
Jeff,

I am unable to use this particular function because we get these emails randomly we don't solicit for them. However they do have to adhere to a predetermined format when sending us such emails. I am new to coding vba not in the use of it.

The format we receive the email in is as follows.

The subject will always be "Move in a Resident"

Applicant Details:
-- Doe, John D  SSN: 000000000

Rent Amount: $700.00
Move In Date: 08/03/2013

Address:
3701 Cimarron Blvd Corpus, Christi, TX 78414

The fields in Microsoft Access Database "Move In" Table "Move In"are
Name
SSN
MoveInAddress
Rent
MoveInDate



If each field and answer were on one line I am pretty sure I would be able to code it.
Please help in any way you can.

Connie
0
Jeffrey CoachmanMIS LiasonCommented:
This system would be very precarious to create.
Parse file, create custom code to validate, create code to import, create code to update, error handling, testing, ...etc

It would also involve a lot of "hand-holding" code if you need this to "Update" the db each day/week month.

The code to do this would be quite involved, and would be beyond the time limits of most experts here to do this on a volunteer basis...

A very simple workaround would be to create a new folder in Outlook (one level below your INBOX) and name it:  MoveInAResident
Then set a rule in Outlok that says any email with the subject: Move in a Resident
...will be moved to this folder.
Then you can open this folder daily and view the new move in's and put them in the db by hand.

This may be a good option if you get very few move-ins.
But if this is a big "Location", then you may want to invest in a custom solution.

Most experts will post their email addresses in their profiles if you would like to contact them for this type of project.

But you can still wait and see if an expert may be willing to take this on here.

JeffCoachman
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Outlook

From novice to tech pro — start learning today.