Outlook VBA自动处理邮件

Outlook 2021-12-26 10:29:15

需求描述
公司里面每天都会有很多邮件，三分之一都是不需要看的，Outlook的过滤功能不错，都可以处理掉。还有些邮件，根据正文或者附件做一下处理自动转发出去就行了。于是上网搜集了一些资料，写个了小程序，共享一下，以后可以参考，也希望对大家有点用处。

实现
废话少说，直接上代码吧。打开Outlook，按Alt+F11打开代码编辑器，输入下面的代码。可能有些兄弟不知道怎么入手，后面会放几个链接做参考。

Sub AutoResponseReceipt(item As MailItem)
Debug.Print ("receive an email")

Dim id As String
Dim SubjectString As String
Dim sender As String
Dim email As Outlook.MailItem

On Error GoTo Err

id = item.EntryID ' 先获取邮件的ID
Set email = Application.Session.GetItemFromID(id)
SubjectString = email.subject ' 邮件主题
sender = email.SenderEmailAddress ' 邮件的发送人地址
Debug.Print ("new email arrivaved: subject is " & SubjectString & " sender is " & sender)

' 校验主题，这里是对主题做过滤，不合适的直接返回不处理
Dim index As Integer
index = InStr(SubjectString, "小票")
If 0 = index Then
index = InStr(SubjectString, "receipt")
If 0 = index Then
Return
End If
End If

' 下面这一段是我自己的一些处理逻辑，调用程序处理附件，
' 然后将程序处理后的结果当做附件转发给另一个人

' 获取附件并执行小票生成程序
Dim PathPrefix As String
PathPrefix = "E:\document\receipt_tool\"
Dim InputFileList As New Collection ' 这个列表存放收到的附件
Dim OutputFileList As New Collection ' 存放程序生成的结果
Dim AttachFile As attachment ' 附件

For Each AttachFile In email.attachments ' email.attachments是所有附件
Debug.Print ("attachment: " & AttachFile.FileName)

Dim InputFile As String
Dim OutputFile As String
InputFile = PathPrefix & AttachFile.FileName
OutputFile = PathPrefix & AttachFile.FileName & ".docx"
Debug.Print ("input file is " & InputFile)
Debug.Print ("output file is " & OutputFile)

AttachFile.SaveAsFile (InputFile) ' 保存附件
Dim cmd As String
cmd = """" & PathPrefix & "receipt.exe" & """" & " " & InputFile & " " & OutputFile
Debug.Print ("command string: " & cmd)
Shell (cmd) ' 执行脚本，生成结果
InputFileList.Add (InputFile)
OutputFileList.Add (OutputFile)

'Kill (InputFile) ' 这里删除的话总会把生成的文件同时删掉
Next

If OutputFileList.Count = 0 Then
Debug.Print ("no attachment")
End If

' 转发邮件
Dim OutMail As Object
Set OutMail = Outlook.Application.CreateItem(olMailItem)
With OutMail
.To = "hnwyllmm@126.com" ' 要转发邮件的收件人地址
.subject = "打印：" & email.subject ' 转发邮件的主题
.Body = "帮忙打印小票，谢谢！" & Chr(10) & email.SenderEmailAddress & Chr(10) & email.SenderName ' 转发邮件的正文
End With

Dim SendAttach As String ' 将程序生成的结果添加到附件中
For i = 1 To OutputFileList.Count
' MsgBox (SendAttach)
SendAttach = OutputFileList(i)
OutMail.attachments.Add (SendAttach)
Next
MsgBox ("send")
OutMail.Send ' 发送邮件
OutMail.Delete ' 删除邮件，没用了

Err:
' 删除生成的文件
For i = 1 To OutputFileList.Count
Kill (OutputFileList(i))
Next

For i = 1 To InputFileList.Count
Kill (InputFileList(i))
Next

email.Delete ' 删除收到的邮件

' 下面几个是释放对象，其实没有也无所谓
Set InputFileList = Nothing
Set OutputFileList = Nothing
Set OutMail = Nothing

End Sub

编辑完保存，在”开始->规则->创建规则”中添加一个过滤规则，在”如何处理该邮件”中选择运行脚本，并选择这个脚本。

标签： VBA自动处理邮件

上一篇：Outlook 自动删除重复邮件VBA脚本下一篇：outlook 过滤邮件规则设置图解详细教程

Outlook VBA自动处理邮件

热门文章

最新文章

标签列表