VB to loop

crook_101

crook_101

Well-known Member
Joined
Oct 20, 2008
Messages
687
Hi all,

I have inherited an excel sheet for our local group that uses VB to send emails - I am an old rusty coder and have cobbled together some code that runs, generates & sends an email. What it doesn't do and I would like it to do is to loop through column BR (If Sheet3.Cells(i, 70).Value = Date Then) looking for all populated date fields and then send the relevant email. Any nudges in the right direction / code would be much appreciated.

Many thanks from a rusty guy just getting back into Excel & VB after retirement!!

VBA Code: 
Public Sub IJSendMailTo()

Dim sender As String
Dim name As String
Dim address As String
Dim subject As String
Dim body As String
Dim bodyFormat As Integer
Dim i As Integer

For i = 2 To Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
    
        If Sheet3.Cells(i, 70).Value = Date Then

sender = "noreply@northumbriabloodbikes.org.uk"
name = "AlanK"
address = Sheet3.Cells(i, 7).Value ' the TO address
subject = "NBB - Invitation To Arrange Your Annual Driver Assessment"
body = "<Body style = font-size:12pt; font-family:Arial>" & "Hi " & Sheet3.Cells(i, 3) & "," & "<br>NBB ID:- " & Sheet3.Cells(i, 1) _
                & "<br><br>Your Annual Driver Assessment is/was due on  <strong>" & Sheet3.Cells(i, 62) & ".</strong><br>" _
    & "<strong><p style=color:red;>" & "Do not book a Car Shift after this date unless your Assessment is completed as you will not be insured.</strong><br><br>" _
    & "<p style=color:black;>" & "Please would you arrange your assessment with one of the Assessors below.<br><br>" _
    & "   ( Durham City )<br><br>" _
    & "   ( Alnwick )<br><br>" _
    & "   ( Ryton )<br><br>" _
    & "   ( Sunderland )</p>" _
    & "Thank you for your continued commitment and support."
        
End If
Next

bodyFormat = 1

    Set oSmtp = New EASendMailObjLib.Mail
    oSmtp.LicenseCode = "TryIt" ' Here goes your license code for the software; for now, we are using the trial version

    ' Please change the server address, username, and password to the ones you will be using       
    ' ALK The KUALO (NBB's) email creds
    
    oSmtp.ServerAddr = "XXXXXX.net"
    oSmtp.UserName = "noreply@northumbriabloodbikes.org.uk"
    oSmtp.Password = "XXXXX"

    oSmtp.ServerPort = 465

    oSmtp.ConnectType = 3
    oSmtp.FromAddr = sender
    oSmtp.AddRecipient name, address, 0
    oSmtp.subject = subject
    oSmtp.bodyFormat = bodyFormat
    oSmtp.BodyText = body
 

Excel Facts

Which lookup functions find a value equal or greater than the lookup value?
MATCH uses -1 to find larger value (lookup table must be sorted ZA). XLOOKUP uses 1 to find values greater and does not need to be sorted.
Sort by date Sort by votes
It's doing that already. Can you elaborate?
Do you perhaps mean that rather than check if the value in BR is todays date, instead just look to see if it contains any valid date?
 
Upvote 0
Hi myall_blues, sorry typed up in a rush before I went out for work.
The workbook is designed to be used by a non excel person. The trigger is them trying CTRL & ; in BR for the specific individual, click on a button linked to this code and the macro will run. The issue is that the code only generates and sends one email even if there should be multiple cells populated in column BR with today’s date. It only sends the email to whoever is furthest down the column (highest row value) and isn’t picking up individuals after this initial email, I guess this is by using the End(xlUp), only grabbing the first populated field it comes to.

Hope this helps and many, many thanks.
Cheers
Ian
 
Upvote 0
Oh I see. The reason it only sends the last one is because the part that actually does the work of sending the email, which begins with the line Set oSmtp = New EASendMailObjLib.Mail is outside the For…Next loop. So if there were twenty with today’s date it will process all those and then send the last one. You should be able to fix it by just moving the Next statement as below. The End If needs to move as well.
Also to note your code has no End Sub statement, but you may have just missed that when you copied it.

VBA Code: 
Public Sub IJSendMailTo()

Dim sender As String
Dim name As String
Dim address As String
Dim subject As String
Dim body As String
Dim bodyFormat As Integer
Dim i As Integer

For i = 2 To Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
    
        If Sheet3.Cells(i, 70).Value = Date Then

sender = "noreply@northumbriabloodbikes.org.uk"
name = "AlanK"
address = Sheet3.Cells(i, 7).Value ' the TO address
subject = "NBB - Invitation To Arrange Your Annual Driver Assessment"
body = "<Body style = font-size:12pt; font-family:Arial>" & "Hi " & Sheet3.Cells(i, 3) & "," & "<br>NBB ID:- " & Sheet3.Cells(i, 1) _
                & "<br><br>Your Annual Driver Assessment is/was due on  <strong>" & Sheet3.Cells(i, 62) & ".</strong><br>" _
    & "<strong><p style=color:red;>" & "Do not book a Car Shift after this date unless your Assessment is completed as you will not be insured.</strong><br><br>" _
    & "<p style=color:black;>" & "Please would you arrange your assessment with one of the Assessors below.<br><br>" _
    & "   ( Durham City )<br><br>" _
    & "   ( Alnwick )<br><br>" _
    & "   ( Ryton )<br><br>" _
    & "   ( Sunderland )</p>" _
    & "Thank you for your continued commitment and support."
        
' End If <== Move End If from here
' Next <== Move Next from here

bodyFormat = 1

    Set oSmtp = New EASendMailObjLib.Mail
    oSmtp.LicenseCode = "TryIt" ' Here goes your license code for the software; for now, we are using the trial version

    ' Please change the server address, username, and password to the ones you will be using       
    ' ALK The KUALO (NBB's) email creds
    
    oSmtp.ServerAddr = "XXXXXX.net"
    oSmtp.UserName = "noreply@northumbriabloodbikes.org.uk"
    oSmtp.Password = "XXXXX"

    oSmtp.ServerPort = 465

    oSmtp.ConnectType = 3
    oSmtp.FromAddr = sender
    oSmtp.AddRecipient name, address, 0
    oSmtp.subject = subject
    oSmtp.bodyFormat = bodyFormat
    oSmtp.BodyText = body
End If   '<== End If statement needs to come down here.
Next i    ' <== Next statement needs to come down here. 
End Sub
 
Upvote 0
Solution
Hi Murray

Many, many thanks, that is running perfectly now 🤩 I've another 15 or so bits of code to amend to generate different emails but I can just use this as a template now and amend the wording for each one.

I'd missed the End Sub off the bottom of the C & P 🤯

Once again, many thanks for your assistance.

Cheers,
Ian
 
Upvote 0
You must log in or register to reply here.

Similar threads

crook_101
  • Question
VBA to loop when sending email
Replies
1
Views
139
crook_101
crook_101
L
  • Question
Sending Email with Table in Body
Replies
3
Views
282
Domenic
D
L
  • Locked
  • Question
How to stop VBA from creating pdf from drop-down list if the value is empty?
Replies
1
Views
195
Fluff
Fluff
M
  • Solved
Optimizing my rows to send e-mail to different address
Replies
2
Views
122
MasterBash
M
H
  • Solved
Macro to extract text to Body in Email and Table at end of Body
Replies
1
Views
555
howard
H

Forum statistics

Threads
1,221,418
Messages
6,159,791
Members
451,589
Latest member
Harold14

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top