Hi there

This could be my first VBA project in Access (if it is possible!) but I am ok with VBA in Excel.

At the moment I read a table from access into excel then run this code on it:

Sub ExtractData()
    Application.ScreenUpdating = False
    Dim Whole As String
    Dim Qty() As String
    Dim StrtPos As Long
    Dim EndPos As Long
    Dim lr As Long
    Dim I As Long
    With Raw
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
        For I = 8 To lr
            Whole = .Cells(I, 1)
            'Event name
            StrtPos = InStr(Whole, "Sub total") + 2
            EndPos = InStr(Whole, " <")
            .Cells(I, 2) = Mid(Whole, StrtPos + 10, EndPos - StrtPos - 10)
            .Cells(I, 2) = Replace(.Cells(I, 2), Chr(10), "")
            Reg.Cells(I + 1, 1) = .Cells(I, 2)
            'First Name
            StrtPos = InStr(Whole, "First Name") + 1
            EndPos = InStr(Whole, "Last") - 2
            .Cells(I, 3) = Mid(Whole, StrtPos + 10, EndPos - StrtPos - 10)
            Surname
            StrtPos = InStr(Whole, "Last Name") + 1
            EndPos = InStr(Whole, "Post") - 2
            .Cells(I, 4) = Mid(Whole, StrtPos + 9, EndPos - StrtPos - 9)
            'Postcode
            StrtPos = InStr(Whole, "Post Code") + 1
            EndPos = InStr(Whole, "Phone") - 2
            .Cells(I, 5) = Mid(Whole, StrtPos + 9, EndPos - StrtPos - 9)
            On Error Resume Next
            'eMail
            StrtPos = InStr(Whole, "Email") + 1
            EndPos = StrtPos + 50
            .Cells(I, 6) = Mid(Whole, StrtPos + 5, EndPos - StrtPos - 5)
            .Cells(I, 6) = Left(.Cells(I, 6), InStr(.Cells(I, 6), Chr(9)) - 1)
            On Error GoTo 0
            'Phone
            StrtPos = InStr(Whole, "Phone") + 1
            EndPos = InStr(Whole, "Email") - 2
            .Cells(I, 7) = Mid(Whole, StrtPos + 5, EndPos - StrtPos - 5)
            'Qty
            StrtPos = InStr(Whole, ">")
            EndPos = InStr(Whole, "First") - 1
            .Cells(I, 8) = Mid(Whole, StrtPos + 4, EndPos - StrtPos - 6)
            .Cells(I, 8) = Replace(.Cells(I, 8), Chr(9), "")
            Qty = Split(.Cells(I, 8))
            .Cells(I, 8) = Qty(1)
            Reg.Cells(I + 1, "G") = Qty(1)
        Next
    End With
End Sub
The table in access is linked to a folder in outlook and contains the body of the emails I want to extract the data from.

The format of the email is always the same as it generated by our website on each ticket sale we make, so the above code is very reliable, but it is quite slow.

What I would like to do:
Every time a new email is received (updated in tblRegistrants in access) it extracts the elements of the email body text that I need into another table.
I can then just update my sheet in excel from the table in access when I need to without having to extract the data every time (much quicker).

Is this possible? If so I'd appreciate any pointers.

Best regards and thanks in anticipation

Paul Ked