1 > I have this below code which searched for emails based on subject however I am able to search and it pops open but it does not reply.

2 > I have another code which emails to the selected people from an excel list with attachments.

Can some one please help me in joining these two codes so that i can search for email and reply (I need to send reminders having the old email as trail email)

Please help.

Sub TestMailTool() ' Is working in Office 2000-2007
Dim OutApp As Object
Dim OutNameSpace As Object
Dim OutFolder As Object
Dim OutItms As Object
Dim OutMail As Object
Dim i As Integer
Dim mail
Dim replyall As Object
'Dim strbody As String
'Dim MyTasks As Object
'Dim sir() As String
'Dim myitems As Outlook.Items
'Dim myitem As Object

Set OutApp = CreateObject("Outlook.Application")
'Set OutMail = OutApp.CreateItem(0)
Set OutNameSpace = OutApp.GetNamespace("MAPI")
Set OutFolder = OutNameSpace.GetDefaultFolder(6)
Set OutItms = OutFolder.Items
i = 1
'Set MyTasks = OutFolder.Items
'Set myitems = myInbox.Items

For Each OutMail In OutFolder.Items
If InStr(OutMail.Subject, "Hello 12345") <> 0 Then

Body = "test reply" & vbCrLf & BR
i = i + 1
End If
Next OutMail
End Sub


Sub Mail_Outlook()
Dim OutApp As Object
Dim OutMail As Object

lastrow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

If Cells(lastrow, 1).Value <> "" Then

MailTo = Cells(lastrow, 1).Offset(0, 2).Value

'Send Mail
For i = 2 To Sheet1.Cells(Rows.Count, 1).End(xlUp).Row
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(o)

With OutMail
.To = Cells(i, 1).Value
.CC = Cells(i, 2).Value
.BCC = ""
.Subject = "Hello 12345" & Cells(i, 4).Value
.Body = "Dear Sir / Madam,"
.Attachments.Add Cells(i, 6).Value

End With

Set OutMail = Nothing
Set OutApp = Nothing

End If

End Sub