Excel VBA匹配"Email"表头取值替换固定邮件收信人地址

核心修改逻辑 #

将代码中原固定取收件人地址的Range("AJ2")部分，替换为以下动态匹配逻辑即可，其余功能代码无需调整：

Dim emailCol As Range
Dim recipientEmail As String
' 遍历第1行表头，匹配内容为"Email"的单元格
Set emailCol = Rows(1).Find(What:="Email", LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False)
If Not emailCol Is Nothing Then
    ' 匹配成功后取表头正下方第2行的单元格值作为收件人地址
    recipientEmail = emailCol.Offset(1, 0).Value
Else
    ' 未匹配到Email表头时的提示，可自行修改提示内容或处理逻辑
    MsgBox "未在第1行找到Email表头，请检查表格格式", vbExclamation
    Exit Sub
End If

后续设置Outlook收件人的代码（如.To = Range("AJ2").Value），统一替换为.To = recipientEmail即可。

匹配规则自定义调整 #

如果需要适配不同的表头格式，可修改Find方法的对应参数：

• 允许部分匹配：若表头可能为「收件人Email」「联系邮箱」等包含Email关键词的内容，将LookAt:=xlWhole修改为LookAt:=xlPart
• 区分大小写匹配：将MatchCase:=False修改为MatchCase:=True
• 忽略前后空格匹配：可将查找逻辑改为匹配Trim(emailCol.Value) = "Email"，自动去除单元格前后空格后再校验

内容的提问来源于stack exchange，提问作者Forrest Batson