[原创] 小闻趣话之- 邮件自动回复

闻启学

今日，小闻在办公室里看微信，忽然老佛爷出现眼前，阴沉讲一句“小闻，上班时间居然玩手机，跟我来，看过怎样处理你”。小闻灰溜溜地跟着后面。江少和斌哥互相对望一眼，老佛爷坐住办公椅讲“小闻，最近很自在？居然在上班时间玩手机！！！”。小闻默默不出声。老佛爷“既然你有时间玩，我帮你增加工作量”，指住笔记本讲，邮箱里未读邮件帮我回复他们，上午要完成任务！！！
小闻睁大眼睛 不出声,老佛爷抛了一句“完成不了，今个月绩效扣500元”！！  这！这真无天理

小闻马上处理 研究 终于以代码完成了

1. 
   
2. '引用：Microseft Outlook *.0 Object Library
   
3. Public j As Inspector
   
4. Sub GetUnReadMailAutoReplyAll()
   
5.     '未读邮件自动回复
   
6. 
   
7.     '功能：根据发件人过滤，读取未读邮件，转发邮件
   
8.     Dim outApp As Outlook.Application
   
9.     Dim myNamespace As Namespace
   
10.     Dim myFolder As MAPIFolder
    
11.     Dim Folder As MAPIFolder
    
12.     Dim iMail As Outlook.MailItem
    
13.     Dim attFilename As String
    
14.     Dim myAttachment As Outlook.Attachment
    
15.     Dim mytmp As String
    
16.     Dim tmpa As String
    
17.     Application.DisplayAlerts = False
    
18.     Application.AskToUpdateLinks = False
    
19.     Application.ScreenUpdating = False
    
20.     '//  Set outApp = GetObject("outlook.Application")
    
21. 
    
22.     '
    
23.     Set outApp = New Outlook.Application
    
24.     Set myNamespace = outApp.GetNamespace("MAPI")
    
25.     'Set myFolder = MyNameSpace.PickFolder
    
26.     Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)    '//获得收件箱文件夹
    
27.     For Each iMail In myFolder.Items
    
28.     Call GetUnReadMail(iMail, myFolder.Name)
    
29.     Next iMai
    
30. 
    
31.     '//数据清零
    
32. 
    
33.     Application.DisplayAlerts = True
    
34.     Application.AskToUpdateLinks = True
    
35.     Application.ScreenUpdating = True
    
36.     Set iMail = Nothing
    
37.     Set myFolder = Nothing
    
38.     Set myNamespace = Nothing
    
39.     Set outApp = Nothing
    
40. End Sub
    
41. Sub GetUnReadMail(myMail As Outlook.MailItem, myFolderName As String)
    
42.     Dim attFilename As String
    
43.     Dim tmpa As String
    
44.     Dim mytmp As String
    
45.     '创建邮件体
    
46. 
    
47.     myForwardHTMLBody = CreateHTMLBody(2)
    
48.     If myMail.UnRead Then
    
49.         Set myAutoForwardMailItem = myMail.ReplyAll
    
50.         MsgBox myMail.SenderEmailAddress
    
51.         '设置收件人
    
52. 
    
53.         myAutoForwardMailItem.Recipients.Add "417149126@qq.com"
    
54.         rcvhtmlBody = myMail.HTMLBody
    
55.         rcvBody = myMail.Body
    
56.         mto = myMail.To
    
57.         '设置邮件体格式为outlook html格式
    
58.         myAutoForwardMailItem.BodyFormat = olFormatHTML
    
59.         '将原始邮件与新邮件连起来
    
60.         myAutoForwardMailItem.To = mto
    
61.         myAutoForwardMailItem.HTMLBody = myForwardHTMLBody & myAutoForwardMailItem.HTMLBody
    
62.         myAutoForwardMailItem.Send
    
63.         myMail.Save
    
64.     End If
    
65. 
    
66. End Sub
    
67. 
    
68. Public Function CreateHTMLBody(id As Integer) As String
    
69.     'Creates a new e-mail item and modifies its properties
    
70.     Dim objHTMLBody As String
    
71.     '可以设置多个模板
    
72.     If id = 1 Then
    
73.         objHTMLBody = _
    
74.         "<font face = 微软雅黑 size = 3>" & _
    
75.         "感谢你的来信。我是<font color=red>机器人小星</font>，邮件我已代为阅读。" & _
    
76.         "<br/> <br/> " & _
    
77.         "来自小星的智能转发</font>"
    
78.     ElseIf id = 2 Then
    
79.         objHTMLBody = _
    
80.         "<table style = border-collapse:collapse <tbody>" & _
    
81.         "<tr><td style = border:1px solid #B0B0B0 colspan= 2>版本</td></tr>" & _
    
82.         "<tr><td style= border:1px solid #B0B0B0 >APP版本</td></tr>" & _
    
83.         "<tr><td style = border:1px solid #B0B0B0>SDK版本</td></tr>" & _
    
84.         "</tbody></table>" & _
    
85.         "" & _
    
86.         "<br/> <br/> " & _
    
87.         "来自小星的智能回复</font>"
    
88.     End If
    
89.     CreateHTMLBody = objHTMLBody
    
90. End Function

复制代码