Hi
try this one. Also put this code in a standard module, not in class module.
Code:Sub SendEmailRowByRow() Dim OutApp As Object Dim OutMail As Object Dim strBody As String Dim LastRow As Long Dim eMailIDs, i As Long Dim varBody Const StartRow As Long = 1 '<<< adjust to suit If Not Application.Intersect(Range("I:I"), ActiveSheet.UsedRange) Is Nothing Then LastRow = Range("I" & Rows.Count).End(xlUp).Row eMailIDs = Range("I" & StartRow).Resize(LastRow - StartRow + 1) For i = 1 To UBound(eMailIDs, 1) Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) varBody = Range("a" & StartRow + i - 1).Resize(, 7).Value strBody = Join(Application.Transpose(Application.Transpose(varBody)), vbTab) On Error Resume Next With OutMail .To = eMailIDs(i, 1) 'email from corresponding row goes here .CC = "" .BCC = "" .Subject = "Expired account notification" '<< adjust subject line .Body = strBody 'You can add a file like this '.Attachments.Add ("C:\") ' .Display .Send Application.Wait Now + TimeSerial(0, 0, 3) Set OutMail = Nothing Set OutApp = Nothing End With On Error GoTo 0 Next End If End Sub




Reply With Quote
Bookmarks