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过程。请相应调整您的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)

相应调整您的代码

End Sub

发布日期无效时宏发送通知

1 个答案: