Excel VBA：识别表单按钮所在行 自动调用Outlook发对应行邮件

核心问题解决逻辑 #

要实现单个宏适配所有行，核心是准确获取触发操作对应的行号：

• 点击L列表单控件按钮触发时，通过Application.Caller获取触发宏的控件对象，用控件的TopLeftCell.Row属性即可拿到控件所在的行号
• G列下拉框选择触发时，通过工作表Change事件的Target参数，直接取Target.Row即可获得操作行号
  拿到行号后，所有单元格引用都动态拼接该行号，即可实现一套代码适配所有行，同时满足点击按钮时给同行L列写入值1的需求。

可直接部署的完整代码 #

通用发信核心宏 #

按Alt+F11打开VBA编辑器，右键插入标准模块，将以下代码粘贴到模块中：

Sub SendRowEmail(Optional triggerRow As Long = 0, Optional ws As Worksheet = Nothing)
    Dim objOutlook As Object
    Dim objEmail As Object
    Dim eRecipient As String, eSubject As String, eBody As String
    Dim ctrl As Shape
    
    ' 未传入行号时判定为表单按钮触发，自动获取按钮所在行
    If triggerRow = 0 Then
        On Error Resume Next
        Set ctrl = ActiveSheet.Shapes(Application.Caller)
        On Error GoTo 0
        If ctrl Is Nothing Then
            MsgBox "请通过L列按钮或G列下拉框触发本功能", vbExclamation
            Exit Sub
        End If
        triggerRow = ctrl.TopLeftCell.Row
        Set ws = ctrl.Parent
    End If
    
    ' 校验必填字段
    If VBA.Trim(ws.Range("K" & triggerRow).Value) = "" Then
        MsgBox "第" & triggerRow & "行未填写收件人邮箱，无法生成邮件", vbExclamation
        Exit Sub
    End If
    
    ' 按规则给同行L列写入值1
    ws.Range("L" & triggerRow).Value = 1
    
    ' 读取配置拼接邮件内容
    eSubject = ws.Range("W14").Value
    eRecipient = ws.Range("K" & triggerRow).Value
    eBody = "See below for details, Link is to Young person's SharePoint Folder, Thank you" & vbNewLine & vbNewLine & vbNewLine & _
            ws.Range("C" & triggerRow).Value & vbNewLine & vbNewLine & _
            ws.Range("D" & triggerRow).Value & vbNewLine & vbNewLine & _
            ws.Range("E" & triggerRow).Value & vbNewLine & vbNewLine & _
            ws.Range("F" & triggerRow).Value & vbNewLine & _
            "Deadline:" & ws.Range("I" & triggerRow).Value & vbNewLine & vbNewLine & vbNewLine & _
            "Best Wishes"
    
    ' 生成预填充邮件
    Set objOutlook = CreateObject("Outlook.Application")
    Set objEmail = objOutlook.CreateItem(0) ' 直接用值0代替olMailItem常量，无需引用Outlook库
    With objEmail
        .Display ' 弹出邮件窗口供确认，测试无误后可删除本行，取消下一行.Send的注释直接发送
        .To = eRecipient
        .CC = ""
        .BCC = ""
        .Subject = eSubject
        .Body = eBody
        ' .Send
    End With
    
    ' 释放对象
    Set objEmail = Nothing
    Set objOutlook = Nothing
    Set ctrl = Nothing
End Sub

G列下拉框自动触发配置 #

如果需要实现G列下拉框选中员工后自动弹出邮件，在VBA编辑器中双击对应工作表（如名为"2022"的工作表），粘贴以下事件代码：

Private Sub Worksheet_Change(ByVal Target As Range)
    ' 仅响应G列的单个单元格修改操作
    If Target.Column = 7 And Target.Cells.Count = 1 Then
        ' 可按需增加判断，比如选中值不为空时才触发
        If VBA.Trim(Target.Value) <> "" Then
            Call SendRowEmail(Target.Row, Me)
        End If
    End If
End Sub

部署操作步骤 #

• 选中L列所有已放置的表单控件按钮，右键选择「指定宏」，统一选中SendRowEmail即可，无需逐行绑定不同宏
• 后续新增行的按钮只要绑定同一个宏，会自动识别所在行号，不需要修改代码
• 代码无需手动引用Outlook对象库，兼容所有Excel版本

原有代码问题说明 #

• 硬编码版本固定引用第2行单元格，无动态行号识别逻辑，仅能支持单行
• 批量发信版本存在语法错误：SendEmail传参时多余右括号、Cycle_Emails_By_Row过程缺少End Sub闭合、变量重复定义、单元格引用未指定行号导致取值错误
• 批量版本循环遍历所有行发信，不符合单条触发的交互需求

内容的提问来源于stack exchange，提问作者Ed Haswell