[轉]Outlook VBA自動處理郵件

本文轉自：https://blog.csdn.net/hnwyllmm/article/details/44874331

需求描述
公司裏面天天都會有不少郵件，三分之一都是不須要看的，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

編輯完保存，在」開始->規則->建立規則」中添加一個過濾規則，在」如何處理該郵件」中選擇運行腳本，並選擇這個腳本。

參考連接
1 Visual Studio 2013 MSDN首頁
2 MSDN:Outlook VBA入門教程 3 Outlook VBA教程 4 Outlook 文件夾定義