通过Outlook编辑和发送邮件的VBS脚本

下载下面的vbs脚本随便放到某个地方，点击运行，将自动调用Outlook建立一封邮件（机器里需安装Office Outlook），自动填入预先指定的收件人，邮件标题为 "报告 2010-12-9"（后面日期可根据当天日期自动改变），并且载入D盘根目录下的"report 2010-12-9.docx"和"report 2010-12-9.pdf"作为附件。

' sdt 为今日日期的字符串，比如 '2010-12-9'，可用于附件名字里
sdt = FormatDateTime(Date)

' 注意：以单引号'开头的行为注释
' receiptions 为收件人列表，多个收件人之间用分号隔开
' Subject 为邮件标题
' Body 为邮件正文
' Attachments 为附件列表，每个附件都需附带路径。
' autoSend 设置是否直接发送，设置为False时将停留在最后窗口，需手动按Outlook的发送按钮进行发送

receiptions = "math.zqy@gmail.com; blog@zhiqiang.org"
Subject = "报告 " & sdt
Body = "附件是今日报告，请查收。"
Attachments = Array("D:\report " & sdt & ".docx", "D:\report " & sdt & ".pdf")
autoSend = False


' 以下代码无需修改
Dim xOutLook
Dim xMail

On Error Resume Next
Set xOutLook = GetObject(, "Outlook.Application")
If xOutLook Is Nothing Then
    Set xOutLook = CreateObject("Outlook.Application")
End If
Set xMail = xOutLook.CreateItem(olMailItem)
With xMail
    .Display
    Dim signature
    signature = .HTMLBody
    .To = receiptions
    .Subject = Subject
    .HTMLBody = Body
    .Importance = olImportanceNormal    ' 设置优先级, olImportanceHigh为高优先级

    Dim xDoc
    Set xDoc = xMail.Application.ActiveInspector.WordEditor

    If IsArray(Attachments) Then
        Dim attachment
        For Each attachment In Attachments
            .Attachments.Add attachment
        Next
    End If

    .HTMLBody = .HTMLBody & signature

    If autoSend Then
        .Send
    Else
        .Display
    End If
End With