VBScript实现Outlook首封未读邮件属性提取与脚本优化

Set FSO = CreateObject("Scripting.FileSystemObject")
dim mail, olMSGUnicode, subject, saveFolder, senderAddress, senderName, emailSubject
dim dd, mm, yy, datevalue, dtsnow, intCount, i, fileName, newFileName, fullSavePath
' 读取传入参数
subject = WScript.Arguments.Item(0)
saveFolder = WScript.Arguments.Item(1)
' 补全保存目录末尾的反斜杠，避免路径拼接错误
If Right(saveFolder, 1) <> "\" Then saveFolder = saveFolder & "\"

' 生成日期戳
dtsnow = Now()
dd = Right("00" & Day(dtsnow), 2)
mm = Right("00" & Month(dtsnow), 2)
yy = Year(dtsnow)
datevalue = dd & mm & yy

Set app = CreateObject("Outlook.Application")
Set ns = app.GetNamespace("MAPI")
Set mf = ns.GetDefaultFolder(6) ' 6对应收件箱
Set mailItems = mf.Items
' 按接收时间倒序，优先处理最新收到的未读邮件
mailItems.Sort "ReceivedTime", True

' 仅处理第一封未读邮件
For Each mail In mailItems
    If mail.Unread Then
        ' --------------------------
        ' 需求1：获取发件人信息
        ' --------------------------
        emailSubject = mail.Subject
        If mail.SenderEmailType = "EX" Then
            ' Exchange内部用户
            Set exchUser = mail.Sender.GetExchangeUser()
            If Not exchUser Is Nothing Then
                senderAddress = exchUser.PrimarySmtpAddress
                senderName = exchUser.Name
            Else
                senderAddress = mail.SenderEmailAddress
                senderName = mail.SenderName
            End If
        Else
            ' 外部邮箱用户
            senderAddress = mail.SenderEmailAddress
            senderName = mail.SenderName
        End If

        ' --------------------------
        ' 需求2：输出发件人、邮件基础信息
        ' --------------------------
        WScript.StdOut.WriteLine "SenderAddress:" & senderAddress
        WScript.StdOut.WriteLine "SenderName:" & senderName
        WScript.StdOut.WriteLine "EmailSubject:" & emailSubject

        ' 处理附件
        intCount = mail.Attachments.Count
        If intCount > 0 Then
            For i = 1 To intCount
                fileName = mail.Attachments.Item(i).DisplayName
                newFileName = datevalue & "_" & fileName
                fullSavePath = saveFolder & newFileName
                mail.Attachments.Item(i).SaveAsFile fullSavePath
                ' 输出每个附件的保存路径
                WScript.StdOut.WriteLine "SavedAttachment:" & fullSavePath
            Next
        Else
            WScript.StdOut.WriteLine "AttachmentCount:0"
        End If

        ' 标记为已读
        mail.Unread = False
        ' --------------------------
        ' 需求3：处理完第一封直接退出循环
        ' --------------------------
        Exit For
    End If
Next

Set FSO = Nothing
Set app = Nothing
Set ns = Nothing

• 适配需求1：新增发件人类型判断逻辑，Exchange内部用户会自动读取SMTP邮箱地址和AD显示名，外部发件人直接读取邮箱地址和发件人显示名，兼容两种发件人场景。
• 适配需求2：新增多维度结构化输出，包括发件人邮箱、发件人名称、邮件主题、每个附件的完整保存路径，输出格式统一为字段名:值，自动化工具可以直接按分隔符拆分提取内容。
• 适配需求3：新增邮件按接收时间倒序排序逻辑，找到最新的第一封未读邮件处理完成后直接退出循环，每次调用脚本仅处理1封邮件，适配全天间歇性收发的使用场景。
• 额外优化了路径拼接逻辑，自动补全保存目录末尾的反斜杠，避免参数传入时少写反斜杠导致的路径错误。

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