Chris

```
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(ln, "=") > 0 Then
workflowID = Replace(Trim(Split(ln, "=")(1)), ")", "")
End If
If InStr(ln, "(") > 0 And InStr(ln, ",") > 0 Then
strTemp = Split(ln, ",")(1)
Name = Trim(Split(strTemp, "(")(0)) & " "
End If
If InStr(ln, "=") > 0 And InStr(ln, ",") > 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
```