pMahesh
08-08-2009, 07:02 AM
Hi
below mention code copy paste & send entire row to outlok email body,but if there is one email id in B column and 4 row are belogns to that email id what will be code, it mean it copy row till find another email id in find in B column.
Option Explicit
Sub Send_Row()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim rng As Range
Dim Ash As Worksheet
Dim StrBody As String
Dim StrhBody As String
StrBody = "Dear Sir/Madam," & "
" & _
"Line 1" & "
" & _
"Line 2" & "
" & _
"Line 3" & "
"
StrhBody = "Line A" & "
" & _
"Line B" & "
" & _
"Line C" & "
"
Set Ash = ActiveSheet
On Error GoTo cleanup
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
For Each cell In Ash.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
Ash.Range("A1:O100").AutoFilter Field:=2, Criteria1:=cell.Value
With Ash.AutoFilter.Range
On Error Resume Next
Set rng = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Test Mail"
.HTMLBody = StrBody & RangetoHTML(rng) & "
" & StrhBody
.Display 'Or use Send
End With
On Error GoTo 0
Set OutMail = Nothing
Ash.AutoFilterMode = False
End If
Next cell
cleanup:
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
' -----------------------------------------------------------------------
'NameEmail 'IDYes/NoLocationIDNoCVAmountAabc@gmail.com (abc@gmail.com)yesABC154114112612345636108Bcbc@gmail.com (cbc@gmail.com)yesABC154114112612345636108Cbcc@gmail.com (bcc@gmail.com)yesABC154114231556461000ABC15411411261234565000ABC1541141126 1234564000ABC154114112612345612500
below mention code copy paste & send entire row to outlok email body,but if there is one email id in B column and 4 row are belogns to that email id what will be code, it mean it copy row till find another email id in find in B column.
Option Explicit
Sub Send_Row()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
Dim OutApp As Object
Dim OutMail As Object
Dim cell As Range
Dim rng As Range
Dim Ash As Worksheet
Dim StrBody As String
Dim StrhBody As String
StrBody = "Dear Sir/Madam," & "
" & _
"Line 1" & "
" & _
"Line 2" & "
" & _
"Line 3" & "
"
StrhBody = "Line A" & "
" & _
"Line B" & "
" & _
"Line C" & "
"
Set Ash = ActiveSheet
On Error GoTo cleanup
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
For Each cell In Ash.Columns("B").Cells.SpecialCells(xlCellTypeConstants)
If cell.Value Like "?*@?*.?*" And LCase(cell.Offset(0, 1).Value) = "yes" Then
Ash.Range("A1:O100").AutoFilter Field:=2, Criteria1:=cell.Value
With Ash.AutoFilter.Range
On Error Resume Next
Set rng = .SpecialCells(xlCellTypeVisible)
On Error GoTo 0
End With
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = cell.Value
.Subject = "Test Mail"
.HTMLBody = StrBody & RangetoHTML(rng) & "
" & StrhBody
.Display 'Or use Send
End With
On Error GoTo 0
Set OutMail = Nothing
Ash.AutoFilterMode = False
End If
Next cell
cleanup:
Set OutApp = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End Sub
' -----------------------------------------------------------------------
'NameEmail 'IDYes/NoLocationIDNoCVAmountAabc@gmail.com (abc@gmail.com)yesABC154114112612345636108Bcbc@gmail.com (cbc@gmail.com)yesABC154114112612345636108Cbcc@gmail.com (bcc@gmail.com)yesABC154114231556461000ABC15411411261234565000ABC1541141126 1234564000ABC154114112612345612500