Office中国论坛/Access中国论坛

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

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



  2. '引用：Microseft Outlook *.0 Object Library
  3. Public j As Inspector
  4. Sub GetUnReadMailAutoReplyAll()
  5.     '未读邮件自动回复

  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")

  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

  31.     '//数据清零

  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.     '创建邮件体

  47.     myForwardHTMLBody = CreateHTMLBody(2)
  48.     If myMail.UnRead Then
  49.         Set myAutoForwardMailItem = myMail.ReplyAll
  50.         MsgBox myMail.SenderEmailAddress
  51.         '设置收件人

  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

  66. End Sub

  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
复制代码






欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3