根据行中的单元格值将自动电子邮件发送到电子邮件地址

Sending automatic email to email address based on cell value in row

我想通过 Outlook 从 Excel 发送自动电子邮件,条件是列中的值大于 2,并从条件为真的同一行中检索特定单元格。

此外,我怎样才能将它发送到保存在该行的一个单元格中的电子邮件地址?

Dim xRg As Range
'Update by Extendoffice 2018/3/7
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Cells.Count > 1 Then Exit Sub
    Set xRg = Intersect(Range("D7:D1000"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 2 Then
        Call Mail_small_Text_Outlook
    End If
End Sub

Sub Mail_small_Text_Outlook()
    Dim xOutApp As Object
    Dim xOutMail As Object
    Dim xMailBody As String
    Set xOutApp = CreateObject("Outlook.Application")
    Set xOutMail = xOutApp.CreateItem(0)
    xMailBody = "Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2"
    On Error Resume Next
    With xOutMail
        .To = "Email Address"
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .Body = xMailBody
        .Display   'or use .Send
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub
    With xOutMail
        .To = Cells(xRg.Row,"A") ' column A
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .Body = xMailBody
        .Display   'or use .Send
    End With