Gobi loganathan
New Member
- Joined
- Jul 18, 2017
- Messages
- 2
Below Mentioned Module Sends Replyall to all mails available in outlook.
I need to send replyall only mail Subject matches the subject in the cell value
can any one help me out...
Sub ReplyMail()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer
Dim rng As Range
Dim cell As Range
Dim OutApp As Object
Dim OutMail As Object
Dim ws As Worksheet
Dim eMsg As String
Dim strRows1 As Range
Dim R As Integer
Dim rows As Integer
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
i = 7
Set rng = Sheets("Sheet2").Range("A1:k7").SpecialCells(xlCellTypeVisible)
Set ws = Sheet2
Matrix2_1 = "<td>" & ws.Range("A" & i).Value & "</td>"
Matrix2_2 = "<td>" & ws.Range("b" & i).Value & "</td>"
Matrix2_3 = "<td>" & ws.Range("c" & i).Value & "</td>"
Matrix2_4 = "<td>" & ws.Range("d" & i).Value & "</td>"
Matrix2_5 = "<td>" & ws.Range("e" & i).Value & "</td>"
Matrix2_6 = "<td>" & ws.Range("f" & i).Value & "</td>"
Matrix2_7 = "<td>" & ws.Range("g" & i).Value & "</td>"
Matrix2_8 = "<td>" & ws.Range("h" & i).Value & "</td>"
Matrix2_9 = "<td>" & ws.Range("i" & i).Value & "</td>"
Matrix2_10 = "<td>" & ws.Range("j" & i).Value & "</td>"
Matrix2_11 = "<td>" & ws.Range("k" & i).Value & "</td>"
Matrix2_12 = "<td>" & ws.Range("l" & i).Value & "</td>"
Matrix2_13 = "<td>" & ws.Range("m" & i).Value & "</td>"
eMsg = "<head><style>table, th, td {border: 1px solid black; border-collapse:" & _
"collapse;}</style></head>******>" & _
"<table style=""width:50%""><tr>" & _
"<th><th colspan=""2"" bgcolor=""#D8D8D8"">Total<th colspan=""2""bgcolor=""#D8D8D8"">Accepted<th colspan=""2""bgcolor=""#D8D8D8"">Rejected<th colspan=""2""bgcolor=""#D8D8D8"">Returned<th colspan=""2""bgcolor=""#D8D8D8"">Realised<th colspan=""2""bgcolor=""#D8D8D8"">Open</tr>" & _
"<th>Client</th><th>Count<th>Amount</th><th>Count<th>Amount</th><th>Count<th>Amount</th><th>Count<th>Amount</th><th>Count<th>Amount</th><th>Count<th>Amount</th></tr>" & _
"<tr>" & Matrix2_1 & "</td>" & Matrix2_2 & "</td>" & Matrix2_3 & "</td>" & Matrix2_4 & "</td>" & Matrix2_5 & "</td>" & Matrix2_6 & "</td>" & Matrix2_7 & "</td>" & Matrix2_8 & "</td>" & Matrix2_9 & "</td>" & Matrix2_10 & "</td>" & Matrix2_11 & "</td>" & Matrix2_12 & "</td>" & Matrix2_13 & "</td> </tr></table>" & _
"<td> </td></tr></Table></body>"
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
On Error Resume Next
For Each olMail In Fldr.Items
If InStr(olMail.Subject, Cells(i, 14)) <> 0 Then
With olMail.ReplyAll
.HTMLBody = " <p>Dear All,<br><br>Please find the attached status file.</p>" & eMsg & .HTMLBody
.Attachments.Add Range("O" & i).Value
.Attachments.Add Range("P" & i).Value
.Display
End With
End If
i = i + 1
Next olMail
'Next i
End Sub
I need to send replyall only mail Subject matches the subject in the cell value
can any one help me out...
Sub ReplyMail()
Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer
Dim rng As Range
Dim cell As Range
Dim OutApp As Object
Dim OutMail As Object
Dim ws As Worksheet
Dim eMsg As String
Dim strRows1 As Range
Dim R As Integer
Dim rows As Integer
Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
Set Fldr = olNs.GetDefaultFolder(olFolderInbox)
i = 7
Set rng = Sheets("Sheet2").Range("A1:k7").SpecialCells(xlCellTypeVisible)
Set ws = Sheet2
Matrix2_1 = "<td>" & ws.Range("A" & i).Value & "</td>"
Matrix2_2 = "<td>" & ws.Range("b" & i).Value & "</td>"
Matrix2_3 = "<td>" & ws.Range("c" & i).Value & "</td>"
Matrix2_4 = "<td>" & ws.Range("d" & i).Value & "</td>"
Matrix2_5 = "<td>" & ws.Range("e" & i).Value & "</td>"
Matrix2_6 = "<td>" & ws.Range("f" & i).Value & "</td>"
Matrix2_7 = "<td>" & ws.Range("g" & i).Value & "</td>"
Matrix2_8 = "<td>" & ws.Range("h" & i).Value & "</td>"
Matrix2_9 = "<td>" & ws.Range("i" & i).Value & "</td>"
Matrix2_10 = "<td>" & ws.Range("j" & i).Value & "</td>"
Matrix2_11 = "<td>" & ws.Range("k" & i).Value & "</td>"
Matrix2_12 = "<td>" & ws.Range("l" & i).Value & "</td>"
Matrix2_13 = "<td>" & ws.Range("m" & i).Value & "</td>"
eMsg = "<head><style>table, th, td {border: 1px solid black; border-collapse:" & _
"collapse;}</style></head>******>" & _
"<table style=""width:50%""><tr>" & _
"<th><th colspan=""2"" bgcolor=""#D8D8D8"">Total<th colspan=""2""bgcolor=""#D8D8D8"">Accepted<th colspan=""2""bgcolor=""#D8D8D8"">Rejected<th colspan=""2""bgcolor=""#D8D8D8"">Returned<th colspan=""2""bgcolor=""#D8D8D8"">Realised<th colspan=""2""bgcolor=""#D8D8D8"">Open</tr>" & _
"<th>Client</th><th>Count<th>Amount</th><th>Count<th>Amount</th><th>Count<th>Amount</th><th>Count<th>Amount</th><th>Count<th>Amount</th><th>Count<th>Amount</th></tr>" & _
"<tr>" & Matrix2_1 & "</td>" & Matrix2_2 & "</td>" & Matrix2_3 & "</td>" & Matrix2_4 & "</td>" & Matrix2_5 & "</td>" & Matrix2_6 & "</td>" & Matrix2_7 & "</td>" & Matrix2_8 & "</td>" & Matrix2_9 & "</td>" & Matrix2_10 & "</td>" & Matrix2_11 & "</td>" & Matrix2_12 & "</td>" & Matrix2_13 & "</td> </tr></table>" & _
"<td> </td></tr></Table></body>"
If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected. " & _
vbNewLine & "Please correct and try again.", vbOKOnly
Exit Sub
End If
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
On Error Resume Next
For Each olMail In Fldr.Items
If InStr(olMail.Subject, Cells(i, 14)) <> 0 Then
With olMail.ReplyAll
.HTMLBody = " <p>Dear All,<br><br>Please find the attached status file.</p>" & eMsg & .HTMLBody
.Attachments.Add Range("O" & i).Value
.Attachments.Add Range("P" & i).Value
.Display
End With
End If
i = i + 1
Next olMail
'Next i
End Sub
