VBS脚本SMTP发送邮件报错：设置发件人地址失败

错误原因分析 #

这个错误主要由以下几个常见问题导致：

• 变量未定义：代码中strCurrentPath未赋值，会导致读取info.txt文件失败，间接干扰CDO对象的正常初始化
• 操作顺序错误：先设置邮件发件人等属性，再配置SMTP服务器，会破坏CDO.Message的内部结构
• 地址格式不规范：发件人地址未按RFC标准用<>包裹，导致CDO解析失败
• 错误处理滥用：过度使用On Error Resume Next掩盖了前置错误，无法定位根本问题

修复步骤 #

1. 给strCurrentPath赋值，获取脚本所在目录
2. 调整操作顺序：先完成SMTP服务器配置，再设置邮件的发件人、收件人等属性
3. 规范发件人地址格式，用<>包裹邮箱（例如"张三 <zhangsan@contoso.com>"）
4. 简化错误处理，仅在必要时使用On Error Resume Next，便于定位问题

修正后的完整代码 #

Function SendEmail()
    ' Email details
    Dim objMessage, strTo, strFrom, strSubject, strBody
    Dim strSMTPServer, intSMTPPort, strSMTPUsername, strSMTPPassword
    Dim strTextFile, objFSO, objTextStream, strFileContent
    Dim strCurrentPath

    ' 获取脚本所在目录，避免文件读取失败
    strCurrentPath = CreateObject("WScript.Shell").CurrentDirectory

    ' 实际使用时替换为正确的邮箱地址
    strTo = "收件人邮箱 <recipient@domain.com>"
    strFrom = "发件人邮箱 <sender@domain.com>" 
    Do
        strSubject = InputBox("Enter a Title", "Ticket Subject")
    Loop Until strSubject <> ""
    
    strBody = InputBox("Enter a message", "Ticket Body")
    
    ' 读取文本文件内容
    strTextFile = strCurrentPath & "\info.txt"
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    ' 增加文件存在判断
    If objFSO.FileExists(strTextFile) Then
        Set objTextStream = objFSO.OpenTextFile(strTextFile, 1)
        strFileContent = objTextStream.ReadAll
        objTextStream.Close
    Else
        WScript.Echo "错误：未找到文件 " & strTextFile
        Exit Function
    End If

    If strBody <> "" Then 
        strBody = strBody & vbNewLine & vbNewLine & strFileContent
    Else 
        strBody = strFileContent
    End If

    MsgBox strBody
    
    ' SMTP服务器配置
    strSMTPServer = "smtp.office365.com"
    intSMTPPort = 587
    strSMTPUsername = "你的Office365邮箱地址" ' 例如sender@domain.com
    strSMTPPassword = "你的邮箱密码或应用密码" ' Office365建议用应用密码（开启MFA时必填）

    ' 创建CDO对象
    Set objMessage = CreateObject("CDO.Message")
    If Err.Number <> 0 Then
        WScript.Echo "Error creating CDO.Message object: " & Err.Description
        Err.Clear
        Exit Function
    End If

    ' 先配置SMTP服务器，再设置邮件属性
    With objMessage.Configuration.Fields
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = intSMTPPort
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
        .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = strSMTPUsername
        .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = strSMTPPassword
        .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
        .Update
    End With

    ' 设置邮件内容属性
    With objMessage
        .From = strFrom
        .To = strTo
        .Subject = strSubject
        .TextBody = strBody
    End With

    ' 发送邮件
    On Error Resume Next
    objMessage.Send
    If Err.Number <> 0 Then
        WScript.Echo "Error sending email: " & Err.Description
        Err.Clear
    Else
        WScript.Echo "Email sent successfully using Office 365 SMTP."
    End If
    On Error GoTo 0

    ' 释放对象
    Set objMessage = Nothing
    Set objFSO = Nothing
End Function

额外注意事项 #

• Office365 SMTP要求启用SMTP AUTH，开启MFA的账号必须使用应用密码登录
• 确保脚本运行环境可访问smtp.office365.com的587端口，无防火墙拦截
• 测试时可临时关闭错误处理，查看原始错误信息，快速定位问题

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