릴리스 날짜가 더 이상 유효하지 않을 때 매크로 보내기 알림

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"에있는 모든 변경된 셀의 날짜를 비교하고 조건이 true이면 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