Excel VBA发送Outlook邮件时如何引用同行C列的邮箱地址？

修改逻辑说明 #

你需要调整两处代码：一是触发条件成立时，把当前修改行对应的C列邮箱地址作为参数传递给发邮件的子程序；二是修改发邮件子程序，接收传入的邮箱地址填入收件人字段。

完整修改后代码 #

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("D2:D1000"), Target)
    If xRg Is Nothing Then Exit Sub
    If IsNumeric(Target.Value) And Target.Value > 2 Then
        ' 读取当前行C列的邮箱地址作为参数传入发邮件子程序
        Call Mail_small_Text_Outlook(Cells(Target.Row, "C").Value)
    End If
End Sub

' 给子程序添加接收邮箱地址的参数
Sub Mail_small_Text_Outlook(xToEmail As String)
    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 & _
              "You have pending quotation which its number" 
    On Error Resume Next
    With xOutMail
        ' 把固定的邮箱替换为传入的参数值
        .To = xToEmail
        .CC = ""
        .BCC = ""
        .Subject = "send by cell value test"
        .Body = xMailBody
        .Display   '调试完成后替换为.Send即可直接发送
    End With
    On Error GoTo 0
    Set xOutMail = Nothing
    Set xOutApp = Nothing
End Sub

注意事项 #

• 确保C列的邮箱地址格式合法，避免触发发送报错
• 代码默认打开邮件预览窗口，测试逻辑无误后把.Display改为.Send即可实现自动发送

内容的提问来源于stack exchange，提问作者Ahmed Thakaa Al-Mubarak