how to send each row by email

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

---

It works flawless!
Thank you so much!

Baris

Hi

Thanks for the feedback. :cheers:

Hi Again,
How can I add cell C(i) to subject line into each email?
What I need to print to subject field for the first line is, for example, "customer11, expired account" etc..
Here is the script and the excel file I run in my pc:

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

---

Code:

---

.Subject = varBody(1, 3) & ", Expired account notification"

---

HI

like

Code:

---

.Subject = Range("C" & i).Value & ", Expired account notification"

---

Thanks to both of you Gentlemen.
I have checked the second one only and works smoothly.

Quote:

---

Originally Posted by Excel Fox

Code:

---

.Subject = varBody(1, 3) & ", Expired account notification"

---

---

Quote:

---

Originally Posted by Admin

HI

like

Code:

---

.Subject = Range("C" & i).Value & ", Expired account notification"

---

---

Thanks
Baris

Hi, this is my first time using excelfox and I'm fairly new to VBA

I would like to add a modified version of this code if you can help me out. I have already written code in an outlook macro that scrapes off excel attachments from emails in a specific folder, savesthe attachments to a folder on my computer, opens the saved attachments in excel, and filters the excel spreadsheet.

Now, I need to map the person's name in column C to specific email adresses and send a message to them if column N has a value less than 5.

Your help would be much appreciated!

So in your attachment, you can check column N like this

Code:

---

If Range("N" & lngRow).Value < 5 Then
'your code to send the message
'in the To part, use Range("C" & lngRow).Value
Else
'Do Nothing
End if

---

You'll have to make the adjustments..... if it's not clear, post back with a sample of the excel saved attachments

Dear Excel fox and Admin,
Last evening I sent 120 email messages with just one click.
Thanks for your help

Now, I have another question. If I should open a new thread, let me know.
I would like to reply my email messages automatically.
When I receive an email which includes "information" phrase in subject line shall be replied with the same excel file which I uploaded earlier to this board. In addition to replying every single email, it will print receipent's email address into excel file to right side cell of related line.

Thanks in advance
Baris