search and send email from outlook using macro from excel

[gmayor]

Not difficult really. It's just a matter of waiting for someone who knows the answer ... like me .

You need the code indicated at the top of the module to start Outlook correctly or the message body editing will not work -
I have not tested the first macro (but it looks OK), but the second one works, subject to valid data in the worksheet.

Option Explicit

'http://www.rondebruin.nl/win/s1/outlook/openclose.htm

Sub TestMailTool() 
Dim OutApp As Object
Dim OutNameSpace As Object
Dim OutFolder As Object
Dim olItem As Object
Dim OutMail As Object
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng As Object
    Set OutApp = OutlookApp()
    Set OutNameSpace = OutApp.GetNamespace("MAPI")
    Set OutFolder = OutNameSpace.GetDefaultFolder(6)
    For Each olItem In OutFolder.Items
        If InStr(OutMail.Subject, "Hello 12345") > 0 Then
            Set OutMail = olItem.Reply
            With OutMail
                .replyall
                .BodyFormat = 2
                Set olInsp = .GetInspector
                Set wdDoc = olInsp.WordEditor
                Set oRng = wdDoc.Range
                .Display
                oRng.Text = "test reply" & vbCr
            End With
        End If
    Next olItem
End Sub

Sub Mail_Outlook()
Dim OutApp As Object
Dim OutMail As Object
Dim LastRow As Long
Dim i As Long
Dim olInsp As Object
Dim wdDoc As Object
Dim oRng 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
    Set OutApp = OutlookApp()
    For i = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
        Set OutMail = OutApp.CreateItem(0)
        With OutMail
            .BodyFormat = 2
            .To = ActiveSheet.Cells(i, 1).value
            .CC = ActiveSheet.Cells(i, 2).value
            .BCC = ""
            .Subject = "Hello 12345 " & ActiveSheet.Cells(i, 4).value
            .Attachments.Add ActiveSheet.Cells(i, 6).value
            .Display
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range
            oRng.Text = "Dear Sir / Madam," & vbCr
        End With
        DoEvents
    Next i
    'End If
    Set OutMail = Nothing
    Set OutApp = Nothing
    Set olInsp = Nothing
    Set wdDoc = Nothing
    Set oRng = Nothing

End Sub