如何在任何特定范围的单元格值发生变化时发送自动电子邮件

时间:2017-03-22 08:16:42

标签: excel vba

如何编写一个excel宏,当特定范围的单元格值之一被更改时,它会发送自动电子邮件?

问题是我选择的细胞范围具有直接链接到其他电子表格单元格的公式。这些单元格的数据已通过Excel的Web连接查询进行更新。如下图所示,a1:b5范围的公式与d1:e5范围相关联。

这是我的语法

Private Sub Worksheet_Change(ByVal Target As Range)


    Dim rngChangeCells As Range
    Dim objOutlookApp As Outlook.Application
    Dim objMailItem As Outlook.MailItem
    Dim strMailBody As String

    On Error Resume Next
    Set rngChangeCells = Intersect(Target, Me.Range("a1:b5"))
    On Error GoTo 0

    If Not rngChangeCells Is Nothing Then

        Set objOutlookApp = New Outlook.Application
        Set objMailItem = objOutlookApp.CreateItem(olMailItem)

        strMailBody = "Cell(s) " & rngChangeCells.Address(False, False) & _
            " in the worksheet '" & Me.Name & "' were modified on " & _
            Format$(Now, "mm/dd/yyyy") & " at " & Format$(Now, "hh:mm:ss") & _
            " by " & Environ$("username") & "."

        With objMailItem
            .To = "myagmarchuluun@gmail.com"
            .Subject = "It has changed"
            .Body = strMailBody
            .Display
        End With

        Set rngChangeCells = Nothing
        Set objOutlookApp = Nothing
        Set objMailItem = Nothing

    End If

End Sub

enter image description here

1 个答案:

答案 0 :(得分:0)

像这样。

注意:将YourMacroName更改为代码中宏的名称。 如果您希望代码适用于其他单元格或更多单元格,则可以更改事件中的范围。

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Range("A1"), Target) Is Nothing Then
        If IsNumeric(Target.Value) And Target.Value > 200 Then
            Call YourMacroName
        End If
    End If
End Sub

测试此示例宏以使用小文本消息创建/显示Outlook邮件。 您必须在标准模块中而不是在工作表模块中复制此宏,请参阅此页面。

注意:我在代码中使用.Display来显示邮件,你可以将其更改为.Send

不要忘记将Change YourMacroName更改为在Change事件中调用Mail_small_Text_Outlook。

Sub Mail_small_Text_Outlook()
'For Tips see: http://www.rondebruin.nl/win/winmail/Outlook/tips.htm
'Working in Excel 2000-2016
    Dim OutApp As Object
    Dim OutMail As Object
    Dim strbody As String

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    strbody = "Hi there" & vbNewLine & vbNewLine & _
              "Cell A1 is changed" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"

    On Error Resume Next
    With OutMail
        .To = "ron@debruin.nl"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = strbody
        'You can add a file like this
        '.Attachments.Add ("C:\test.txt")
        .Display   'or use .Send
    End With
    On Error GoTo 0

    Set OutMail = Nothing
    Set OutApp = Nothing
End Sub

https://www.rondebruin.nl/win/s1/outlook/bmail9.htm