mercredi 20 mars 2019

Macro emails rows: Loop needs Error handling Else statements and msgbox when Macro is done or exits

I have a working macro that emails rows when the current date is found in column "U". Sheet1 row is then copied to Sheet2. Currently it sends the email automatically, I'd like to .display my message but the macro continue to loop through column"U" to find additional rows and does not send all the rows. I would also like to add a msgbox for when "U" rows have been sent else when "U" column does not hold the current date and exit the macro.

Sub date_exists() 
Dim s As Range
Dim d As Date, i As Long
d = Date

For i = 1 To Cells(Rows.Count, "U").End(xlUp).Row
'For Each i In Range("U:U") Added looping language
On Error GoTo 2
If Cells(i, "U").Value = d Then
Cells(i, "C").EntireRow.Select
Selection.Copy
Range("A2").Select
ActiveSheet.Paste

ActiveSheet.Range("A1:M2").Select

   ActiveSheet.Range("A1:M2").Select


   ActiveWorkbook.EnvelopeVisible = True      





    With ActiveSheet.MailEnvelope
  .Introduction = "Recommends: " &        
    Sheets("Sheet1").Range("C2") & "Please select your vote."
  .Item.To = ActiveWorkbook.Sheets("Sheet1").Range("I2")
  .Item.CC = ActiveWorkbook.Sheets("Sheet1").Range("K2")
  .Item.Subject = ("Vote Request: ") & 
   Sheets("Sheet1").Range("F2") & "_" & 
  Sheets("Sheet1").Range("G2") & ("_Vote_Deadline_") &                      Sheets("Sheet1").Range("N2")
  .Item.HTMLBody = "Recommends: " & .Sheets("Sheet1").Range("C2")
  .Item.Display


       End With


End If

Next i 
2:
MsgBox "No Meetings"
Exit Sub



End Sub

Aucun commentaire:

Enregistrer un commentaire