リリース日付が有効でないときにマクロが通知を送信

Question

次に、セルDと現在の日付を比較するマクロがあります。過去の場合は、セルLで定義された電子メールに通知を送信します。手動でマクロを実行する必要はありませんので、Alt + F8キーを押して手動で実行してください。そのため、更新されたセルD値が過去であることがわかったときにマクロを自動的に実行させる方法があります。事前に

おかげ

Sub SendMail() 
Dim OutApp As Object 
Dim OutMail As Object 
Dim RelDate As Range 
Dim lastRow As Long 
Dim dateCell, dateCell1 As Date 

Application.ScreenUpdating = False 
Set OutApp = CreateObject("Outlook.Application") 
OutApp.Session.Logon 
lastRow = Range("A" & Rows.Count).End(xlUp).Row 
On Error GoTo cleanup 
For Each RelDate In Range("D2:D" & lastRow) 
If RelDate = "" Then GoTo 1 
dateCell = RelDate.Value 
dateCell1 = Cells(RelDate.Row, "C").Value 

If dateCell < Date Then ' this if cell value is smalle than today then it will send notification 
     Set OutMail = OutApp.CreateItem(0) 
     On Error Resume Next 
     With OutMail 
      .To = Cells(RelDate.Row, "L").Value 
      .Subject = "Release Date Changed"   ' Change your massage subject here 
      'Change body of the massage here 
      .Body = "Dear " & Cells(RelDate.Row, "E").Value _ 
        & vbNewLine & vbNewLine & _ 
        "The release date of " & Cells(RelDate.Row, "A").Value & _ 
        " is changed to " & dateCell _ 
        & vbNewLine & vbNewLine _ 
        & vbNewLine & vbNewLine & _ 
        "Regards," & vbNewLine & _ 
        "Your Name" 
      .send 
     End With 
     On Error GoTo 0 
     Set OutMail = Nothing 
    End If 
    ' Cells(RelDate.Row, "C").Value = dateCell 
    ' RelDate.ClearContents 
    1: Next RelDate 
    cleanup: 
    Set OutApp = Nothing 
    Application.ScreenUpdating = True 
    End Sub 

Answer 1

はworksheet_changeイベントにこのコードを使用します。列 "D"のすべての変更されたセルの日付を比較し、条件が真であれば、sendmailプロシージャを呼び出します。それに応じてsendmailコードを調整してください。 このコードは、複数の行のデータをコピーする場合にも機能します。 希望！ :-)

Private Sub Worksheet_Change(ByVal Target As Range) 
Dim to_email As String 
Dim subject As String 
Dim body As String 
For Each cell In Target.Cells 
    On Error Resume Next 
    If cell.Column = 4 And cell < Date Then 
     On Error GoTo errhandler 
     to_email = ActiveSheet.Cells(cell.Row, "L").Value 
     subject = "Release Date Changed" 
     body = "Dear " & ActiveSheet.Cells(cell.Row, "E").Value _ 
       & vbNewLine & vbNewLine & _ 
       "The release date of " & ActiveSheet.Cells(cell.Row, "A").Value & _ 
       " is changed to " & ActiveSheet.Cells(cell.Row, 4) _ 
       & vbNewLine & vbNewLine _ 
       & vbNewLine & vbNewLine & _ 
       "Regards," & vbNewLine & _ 
       "Your Name" 
     sendmail to_email, subject, body 
    End If 
Next cell 

Exit Sub 

errhandler: 
Err.Raise Err.Number, Err.Source, Err.Description 

End Sub 



Sub sendmail(to_email As String, subject As String, body As String) 

`Worksheet_Change`イベントについてどう応じ

End Sub