Do Until IsEmpty loop check value condition and then send email

[aagarwal]

Hi all,

I have and excel sheet which has Environment name in column A and it should send email to the respective group until the cell value is empty.
Also in Column D, I have the expiry dates and status and if the expiry date is equal or less than 60 days, it should send email automatically.

My problem is how to set the until loop or any other alternative to enter every cell and check the condition

Code that I have used atm:

Private Sub CommandButton3_Click()

Dim OutlookApp As Object, OutLookMailItem As Object
Dim i As Byte, row_num As Byte
row_num = 2

Set OutlookApp = CreateObject("Outlook.application")
Set OutLookMailItem = OutlookApp.CreateItem(0)

i = 2

Do Until IsEmpty(Cells(i, 1))

    With OutLookMailItem
        .To = "email@gmail.com"
        .Subject = "[RESPONSE REQUIRED] Client's Environment Expiry Alert Notification - " & Sheets(2).Cells(row_num, 2)
        .Body = "Hi Team" & vbNewLine & vbNewLine _
                & "The Client Account : " & Sheets(2).Cells(row_num, 3) & "' with the  environment name - '" & Sheets(2).Cells(row_num, 2) _
                & "' is expiring on " & Sheets(2).Cells(row_num, 4)
                
        .send

    End With

row_num = row_num + 1

Loop

Set OutLookMailItem = Nothing
Set OutlookApp = Nothing

End Sub

 

[6StringJazzer]

I don't think "collated" is the right word here. You want to send a single email that lists all expired environments, instead of sending an email for each one? I have no way to test this but this should work:

Private Sub CommandButton3_Click()

   Dim OutlookApp As Object, OutLookMailItem As Object
   Dim row_num As Byte
   row_num = 2
 
   Set OutlookApp = CreateObject("Outlook.application")
 
   Set OutLookMailItem = OutlookApp.CreateItem(0)
   With OutLookMailItem
       .To = "email@gmail.com"
       .Subject = "[RESPONSE REQUIRED] Client's Environment Expiry Alert Notification - " & Sheets(2).Cells(row_num, 2)
       .body = "Hi Team" & vbNewLine & vbNewLine
                
      Do Until IsEmpty(Cells(row_num, 1))
    
          If Cells(row_num, "D") < Date + 60 Then
             
             .body = .body & vbNewLine & _
                  "The Client Account : " & Sheets(2).Cells(row_num, 3) & "' with the  environment name - '" & Sheets(2).Cells(row_num, 2) _
                  & "' is expiring on " & Sheets(2).Cells(row_num, 4)
   
          End If
    
          row_num = row_num + 1
    
      Loop
    
     .send
          
   End With
   
   Set OutLookMailItem = Nothing
   Set OutlookApp = Nothing

End Sub