If you want to forward the mail with its text and a covering message then change as follows:
Sub AutoResponse(olItem As MailItem)
Dim olOutMail As Outlook.MailItem
Dim olInsp As Outlook.Inspector
Dim wdDoc As Object
Dim oRng As Object
Dim sText As String
Dim sSubject As String
Dim vText As Variant, vItem As Variant
Dim i As Long
sText = olItem.Body
vText = Split(sText, Chr(13))
sSubject = ""
For i = 1 To UBound(vText)
If InStr(1, vText(i), "5.tour_booked : ") > 0 Then
vItem = Split(vText(i), Chr(58))
sSubject = sSubject & Trim(vItem(1))
End If
If InStr(1, vText(i), "5.tour_price : ") > 0 Then
vItem = Split(vText(i), Chr(58))
sSubject = sSubject & Chr(32) & Trim(vItem(1))
End If
Next i
Set olOutMail = olItem.Forward
With olOutMail
.To = "someone@somewhere.com" ' the recipient of the message
.Subject = sSubject
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range(0, 0)
oRng.Text = "This is the covering message"
.Display 'Retain this line
'.Send 'Restore after testing
End With
lbl_Exit:
Set olOutMail = Nothing
Exit Sub
End Sub
If you want to send on the message exactly as it arrived but with a different subject then
Sub AutoResponse(olItem As MailItem)
Dim sText As String
Dim sSubject As String
Dim vText As Variant, vItem As Variant
Dim i As Long
sText = olItem.Body
vText = Split(sText, Chr(13))
sSubject = ""
For i = 1 To UBound(vText)
If InStr(1, vText(i), "5.tour_booked : ") > 0 Then
vItem = Split(vText(i), Chr(58))
sSubject = sSubject & Trim(vItem(1))
End If
If InStr(1, vText(i), "5.tour_price : ") > 0 Then
vItem = Split(vText(i), Chr(58))
sSubject = sSubject & Chr(32) & Trim(vItem(1))
End If
Next i
Set olOutMail = Application.CreateItem(olMailItem)
With olOutMail
.To = "someone@somewhere.com" ' the recipient of the message
.Subject = sSubject
.BodyFormat = olItem.BodyFormat
If .BodyFormat = olFormatHTML Then
.HTMLBody = olItem.HTMLBody
Else
.Body = olItem.Body
End If
.Display 'change to '.Send after testing
End With
lbl_Exit:
Set olOutMail = Nothing
Exit Sub
End Sub