Split Outlook Email into Access Columns based on Lables

[alexbeatle]

Good day,

Here's an example of emails I receive:

Header Code:STANDARD UPDATE

Ticket No: 20143 Seq. No: 47
Update of: 201428



Send To: ABC Seq No: 6565 Map Ref: 416 531

Original Call Date: 08/20/2014 Time: 10:56:43 AM OP: 997
Transmit Date: 08/20/2014 Time: 10:57:21 AM
Work to Begin Date: 08/27/2014 Time: 08:00:00 AM
.....

Could you suggest how can I split this email body based on the Titles (Header Code:,Ticket No:, Update of

The code I'm using to populate the Access database is

Private Sub cOutlookGetData_Click()
'****************************************************************************************
'Open Outlook
Dim appOutlook As Object
Dim folderOutlook As Object
    ' Initialize outlook objects
    On Error Resume Next
    Set appOutlook = GetObject(, "Outlook.Application")
    If Err <> 0 Then
        ' attempt to start outlook, can be used to start a second instance of outlook
        Set appOutlook = CreateObject("Outlook.Application")
    End If
        Set namespaceOutlook = appOutlook.GetNamespace("MAPI")
        Set folderOutlook = namespaceOutlook.GetDefaultFolder(6) '6=Inbox, 5=Sent Items
        folderOutlook.Display 'make visible
'****************************************************************************************
'ExtractData
Dim TempRst As DAO.Recordset
Dim rst As DAO.Recordset
Dim Mailobject As Object
Dim folderOutlookItems As Object
Dim db As DAO.Database
Dim dealer As Integer

'delete all data from the temp table, disable the warning
With DoCmd
    .SetWarnings False
    .RunSQL "Delete * from tbl_outlooktemp"
    .SetWarnings True
End With

Set db = CurrentDb 'set the database as curretly opened Access database
Set TempRst = CurrentDb.OpenRecordset("tbl_OutlookTemp")

Set folderOutlookItems = folderOutlook.Items
For Each Mailobject In folderOutlookItems
'If Mailobject.UnRead Then
    With TempRst
    .AddNew
    !Subject = Mailobject.Subject
    !from = Mailobject.SenderName
    !To = Mailobject.To
    !Body = Mailobject.Body
    !DateSent = Mailobject.SentOn
    .Update
    Mailobject.UnRead = False
    End With
'End If
Next
'****************************************************************************************
'TidyUp
Set namespaceOutlook = Nothing
Set appOutlook = Nothing
Set folderOutlook = Nothing
Set folderOutlookItems = Nothing
Set Mailobject = Nothing
Set TempRst = Nothing
End Sub

Thank you

[pbaldy]

I've done a couple of these. I used the Split() function to break the body into each line. Then loop the resulting array looking for the keys like "Header Code" then extracting what comes after the colon. Yours will be more difficult since it appears there can be multiple values on a line. If there's a predictable pattern you may be able to use InStr() to determine the position of each portion within a line.

[alexbeatle]

Thanks
Found this:

Function ParseTextLinePair _
  (strSource As String, strLabel As String)
    Dim intLocLabel As Integer
    Dim intLocCRLF As Integer
    Dim intLenLabel As Integer
    Dim strText As String
    intLocLabel = InStr(strSource, strLabel)
    intLenLabel = Len(strLabel)
        If intLocLabel > 0 Then
        intLocCRLF = InStr(intLocLabel, strSource, vbCrLf)
        If intLocCRLF > 0 Then
            intLocLabel = intLocLabel + intLenLabel
            strText = Mid(strSource, _
                            intLocLabel, _
                            intLocCRLF - intLocLabel)
        Else
            intLocLabel = _
              Mid(strSource, intLocLabel + intLenLabel)
        End If
    End If
    ParseTextLinePair = Trim(strText)
End Function

on Chapter 17: Working with Item Bodies

This splits body into lines based on label.
Any idea how I can split within line, since I have multiple labels per line?

[pbaldy]

You mean other than what I already mentioned?

If there's a predictable pattern you may be able to use InStr() to determine the position of each portion within a line.

By that I mean if you test for "Seq No:" and "Map Ref:", you can derive the portion between. Again, that would require a consistent pattern, like those all being on the same line with "Send To:"

[alexbeatle]

You mean other than what I already mentioned?



By that I mean if you test for "Seq No:" and "Map Ref:", you can derive the portion between. Again, that would require a consistent pattern, like those all being on the same line with "Send To:"

I see, I didn't get it at first, this is what I have for one of them. Might be helpful for others:

subString() as string
........
str = ParseTextLinePair(strMsgBody, "Ticket No:")
If (Len(str) > 0) Then
While InStr(str, "  "): str = Replace(str, "  ", " "): Wend
subString() = Split(str, " ")
strTicketNo = subString(0)
Else
strTicketNo= str
End If
.........
With TempRst
.AddNew
.........
!TicketNo=strTicketNo
.........
.Update
End With