search and send email from outlook using macro from excel

[spanx]

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


OutMail.Display
OutMail.replyall
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
.Display

End With

Set OutMail = Nothing
Set OutApp = Nothing
Next

End If

End Sub

[spanx]

Can someone please help, I am in desperate need of a solution.

Pleaseeeeeeeeeeeeeee.

[spanx]

Not a single reply, is it too difficult what i am asking?

[gmayor]

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

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

[spanx]

To
CC
Subject
Body
Attachment
Subject to be searched



example1emailadd
Supervisoremailid
Reminder 1
Immediate effect

Hello 12345


example2emailadd
Supervisoremailid
Reminder 2
Please revret

RE: FUN Friday on Friday

























Hi Graham ,

Sorry for the late reply, was not well hence could not work all these months. But back to work and desperately need your help.

The above is an example of excel that I have. I tried yours but somehow its not working.

Issues faced are :-
1> the original email content is missing, so it displays a new email but not the old email content.
2> it does not contain original email sender and all others in CC, it picks up "To" and "CC" from excel.

What i exactly want is , it should search subject from column "F" and reply along with additional details from column A, B, C, D, E. what should I do if I have different subjects every time, changing subject in code is tedious and hence I would request you to help me so that it loops until the last line of column F that is the subject line.

I would be highly obliged if you could please help me in this.

Thanking you in Advance and once again sorry for the inconvenience.

[gmayor]

Sorry to hear that you have been unwell. I am all too familiar with that. However it is not exactly clear what it is that you expect to happen.
There are two macros I based on your originals. One sends a reply to any message in the folder that contains "Hello 12345" in the subject. The other creates a new message for each entry in the worksheet without reference to existing message. From your recent post I suspect that you want a macro that somehow combines the two?
Can you confirm you are wanting to look through the folder for each matching subject in the worksheet and send a reply to that e-mail using the values in the worksheet?

[spanx]

Yes that's what I am exactly looking for.

It should search from all folders in outlook and reply to that email with the old content of email below and above it the content in the excel sheet.

For instance I have a list of subjects in excel so it should search each subject from the column and reply.

Thank you for all your help.

[gmayor]

Maybe the following will work for you. It will prompt to select the folder to process.


Option Explicit

'Graham Mayor - https://www.gmayor.com - Last updated - 04 Feb 2019
'Requires the code from
'http://www.rondebruin.nl/win/s1/outlook/openclose.htm

Sub ReplyToMail()
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
Dim lngRow As Long
Set OutApp = OutlookApp()
Set OutNameSpace = OutApp.GetNamespace("MAPI")
On Error Resume Next
Set OutFolder = OutNameSpace.pickfolder
If Err.Number > 0 Then GoTo lbl_Exit
For Each olItem In OutFolder.Items
For lngRow = 2 To ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
If InStr(olItem.Subject, ActiveSheet.Cells(lngRow, 6)) > 0 Then
Set OutMail = olItem.Reply
With OutMail
.BodyFormat = 2
.To = ActiveSheet.Cells(lngRow, 1).value
.CC = ActiveSheet.Cells(lngRow, 2).value
.BCC = ""
.Subject = .Subject & " - " & ActiveSheet.Cells(lngRow, 3).value
.Attachments.Add ActiveSheet.Cells(lngRow, 6).value
.Display
Set olInsp = .GetInspector
Set wdDoc = olInsp.WordEditor
Set oRng = wdDoc.Range
oRng.collapse 1
oRng.Text = "Dear Sir / Madam," & vbCr & _
ActiveSheet.Cells(lngRow, 4).value
'.send
End With
Exit For
End If
DoEvents
Next lngRow
DoEvents
Next olItem
lbl_Exit:
Set OutNameSpace = Nothing
Set OutMail = Nothing
Set OutFolder = Nothing
Set OutApp = Nothing
Set olInsp = Nothing
Set wdDoc = Nothing
Set oRng = Nothing
Exit Sub
End Sub

[spanx]

Thanks a lot for all your help Graham...

:bow:

[prakyi]

Hi Spanx, I am newbie to VBA I tried copy pasting the code in excel module but I am not able to run the macro, would be great if you can share the file or the full code. Thanks a million for your support and help.

[SamT]

Spanx has not visited this site since 2/11/2019.

See GMayor's posts above.

I have closed this thread. If you need more help, please start a new thread. You can post a link to this thread in you new thread.