如何编写一个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
答案 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