Multiple Email send.

[vmjan02]

hi,

I have this code below and it sends an email, but for only one record. I am not able to send multipal emails of multipal records.

code:-
Sub Table()


Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object


Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a fixed range if you want
Set rng = Sheets("Actual Email").Range("A1:E21").SpecialCells(xlCellTypeVisible)
On Error GoTo 0


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


Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)


On Error Resume Next
With OutMail

'.To = ""
.CC = ""
.Subject = Sheets("Actual Email").Range("i1")
.HTMLBody = RangetoHTML(rng) '
' .Body = Selection.Paste
.Send
'.Display 'or use .Send
End With
On Error GoTo 0


With Application
.EnableEvents = True
.ScreenUpdating = True
End With


Set OutMail = Nothing
Set OutApp = Nothing


End Sub

I have the sheet name as CopyData and in column A4 I have the TT number
A4 TT
A5 1
A6 2
A7 3

Now the above Table code should first send the email of A5, once email is send, then It should shed the records of A6 and so on.
I mean is when were the TT number changes in the column of A in "CopuData" sheet an Table code should work and should be able to send 1 mail for each TT number.

Any Idea.

 

[vmjan02]

Re: Multipel Email send.

any update on the same, thanks