Related post to get email data to excel.

Sub Q26477149(mai As MailItem)
Dim dateRecd As String
Dim id As String
Dim raised As String
Dim summary As String
Dim details As String
Dim dateDue As String
Dim workflowID As String
Dim Name As String
Dim ln As Variant
Dim strTemp As String
Dim xlApp As Object
Dim rw As Long
Const xlup As Integer = -4162

    If InStr(mai.body, vbCrLf) = 0 Then Exit Sub
    dateRecd = Format(mai.ReceivedTime, "ddd dd/mm/yyyy")
    For Each ln In Split(Replace(mai.body, Chr(160), " "), vbCrLf)
        If InStr(ln, ":") > 0 Then
            If LCase(ln) Like "incident id*" Then
                id = Trim(Split(ln, ":")(1))
            ElseIf LCase(ln) Like "raised user*" Then
                raised = Trim(Split(ln, ":")(1))
            ElseIf LCase(ln) Like "summary*" Then
                summary = Trim(Split(ln, ":")(1))
                If InStr(strTemp, "=") > 0 Then
                    workflowID = Replace(Trim(Split(ln, "=")(1)), ")", "")
                End If
                If InStr(strTemp, "(") > 0 And InStr(strTemp, ",") > 0 Then
                    strTemp = Split(ln, ",")(1)
                    Name = Trim(Split(strTemp, "(")(0)) & " "
                End If
                If InStr(strTemp, "=") > 0 And InStr(strTemp, ",") > 0 Then
                    strTemp = Split(ln, ",")(0)
                    Name = Name & Split(strTemp, "-")(UBound(Split(strTemp, "-")))
                End If
            ElseIf LCase(ln) Like "details*" Then
                details = Trim(Split(ln, ":")(1))
            ElseIf LCase(ln) Like "date*" Then
                dateDue = Split(Trim(Split(ln, ":")(1)), " ")(0)
            End If
        End If
    Next
    Set xlApp = CreateObject("excel.application")
    With xlApp.workbooks.Open("C:\Users\Chris\Experts Exchange\Outlook-to-excel.xls")
        rw = .sheets(1).Range("A" & .sheets(1).Rows.count).End(xlup).Row + 1
        .sheets(1).Range("A" & rw) = dateRecd
        .sheets(1).Range("B" & rw) = id
        .sheets(1).Range("C" & rw) = raised
        .sheets(1).Range("D" & rw) = summary
        .sheets(1).Range("E" & rw) = details
        .sheets(1).Range("F" & rw) = dateDue
        .sheets(1).Range("G" & rw) = workflowID
        .sheets(1).Range("H" & rw) = Name
        .Close True
    End With
    xlApp.Quit
End Sub

Select allOpen in new window