how to send each row by email

[BARIS]

Hi,

Your StartRow should be 1.

Hi,
Outlook seems like as if it is going to send email messages to all individuals but only one email message window comes out. When I click to send button, i see only one message in "sent items" box. VB code sends email to last person only.


fyi
Baris

[Admin]

Hi

try this one. Also put this code in a standard module, not in class module.

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

[BARIS]

It works flawless!
Thank you so much!

Baris

[Admin]

Hi

Thanks for the feedback.

[BARIS]

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:

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

[Excel Fox]

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

[Admin]

HI

like

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

[BARIS]

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

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

HI

like

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

Thanks
Baris

[Excel Fox]

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

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

[BARIS]

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