右键菜单调用VBScript发送带附件邮件失败求助

问题描述 #

我需要通过右键菜单运行VBScript，将右键点击的文件作为附件发送邮件。已完成注册表配置（路径为Computer\HKEY_CLASSES_ROOT*\shell\Mail及command项，命令为c:\Windows\System32\mail.vbs "%1"），并通过WScript.Arguments(0)在VBScript中接收文件路径。当前脚本执行后弹窗显示邮件已发送，但实际邮件并未发出，请求排查问题。

附原代码：

Set objMail = CreateObject("CDO.Message")
Set objConf = CreateObject("CDO.Configuration")
Set objFlds = objConf.Fields
 
'Set various parameters and properties of CDO object
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing Jump ") = 2 'cdoSendUsingPort
'your smtp server domain or IP address goes here such as smtp.yourdomain.com
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver Jump ") = "smtp.mail.yahoo.com"
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport Jump ") = 25 'default port for email
'uncomment next three lines if you need to use SMTP Authorization
'objFlds.Item("http://schemas.microsoft.com/cdo/configuration/sendusername Jump ") = "your-username"
'objFlds.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword Jump ") = "your-password"
'objFlds.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate Jump ") = 1 'cdoBasic
objFlds.Update
objMail.Configuration = objConf
objMail.From = "fromEmailAddress@yourdomain.com"
objMail.To = "toEmailAddress@yourdomain.com"
objMail.Subject = "Put your email's subject line here"
objMail.TextBody = "Your email body content goes here"

Attach = WScript.Arguments(0)

objMail.AddAttachment Attach 'Don't use = after AddAttachment, just provide the path
objMail.Send
 
'Set all objects to nothing after sending the email
Set objFlds = Nothing
Set objConf = Nothing
Set objMail = Nothing

排查要点及修复方案 #

• CDO配置字段URL错误：原代码中所有CDO配置字段的URL末尾都多了Jump字符串，这会导致CDO无法识别配置项，必须删除这些多余字符。
• SMTP服务器参数不匹配：Yahoo的SMTP服务器已不再支持25端口，需改用587端口并启用SSL/TLS；同时Yahoo强制要求SMTP认证，必须取消注释认证相关代码行，填入正确的邮箱用户名（前缀）和应用专用密码（Yahoo普通账号密码无法用于SMTP认证，需在账号设置中生成应用专用密码）。
• 缺失错误捕获机制：原脚本没有错误处理逻辑，即使发送失败也会执行到最后，导致误判发送成功。需添加错误捕获代码，以便定位具体失败原因。
• 文件路径验证：可临时添加MsgBox "要附加的文件路径：" & Attach语句，确认传递的文件路径是否正确（尤其是带空格的路径）。

修正后的完整代码 #

On Error Resume Next ' 启用错误捕获机制
Set objMail = CreateObject("CDO.Message")
Set objConf = CreateObject("CDO.Configuration")
Set objFlds = objConf.Fields
 
' 配置CDO核心参数
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2 ' 使用端口发送
' Yahoo SMTP服务器正确配置
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.yahoo.com"
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 587 ' TLS协议端口
' 启用SMTP认证（必须填写正确信息）
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "你的Yahoo邮箱前缀（不含@yahoo.com）"
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "你的Yahoo应用专用密码"
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 ' 基础认证
objFlds.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True ' 启用SSL加密
objFlds.Update
objMail.Configuration = objConf

' 设置邮件内容
objMail.From = "你的完整Yahoo邮箱@yahoo.com"
objMail.To = "收件人完整邮箱地址"
objMail.Subject = "自定义邮件主题"
objMail.TextBody = "自定义邮件正文内容"

' 获取附件路径
Attach = WScript.Arguments(0)
' 可选：验证路径是否正确
' MsgBox "待附加文件路径：" & Attach

' 添加附件并发送
objMail.AddAttachment Attach
objMail.Send
 
' 检查发送结果并提示
If Err.Number <> 0 Then
    MsgBox "邮件发送失败！错误信息：" & Err.Description & vbCrLf & "错误代码：" & Err.Number
Else
    MsgBox "邮件发送成功！"
End If

' 释放对象资源
Set objFlds = Nothing
Set objConf = Nothing
Set objMail = Nothing

内容的提问来源于stack exchange，提问作者Tathastu Pandya