设为首页收藏本站Access中国

Office中国论坛/Access中国论坛

 找回密码
 注册

QQ登录

只需一步,快速开始

扫一扫,访问微社区

返回列表 发新帖
查看: 112|回复: 0

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

[复制链接]
发表于 2019-4-14 10:58:22 | 显示全部楼层 |阅读模式
今日,小闻在办公室里看微信,忽然老佛爷出现眼前,阴沉讲一句“小闻,上班时间居然玩手机,跟我来,看过怎样处理你”。小闻灰溜溜地跟着后面。江少和斌哥互相对望一眼,老佛爷坐住办公椅讲“小闻,最近很自在?居然在上班时间玩手机!!!”。小闻默默不出声。老佛爷“既然你有时间玩,我帮你增加工作量”,指住笔记本讲,邮箱里未读邮件帮我回复他们,上午要完成任务!!!
小闻睁大眼睛 不出声,老佛爷抛了一句“完成不了,今个月绩效扣500元”!!  这!这真无天理

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



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

  5.     '功能:根据发件人过滤,读取未读邮件,转发邮件
  6.     Dim outApp As Outlook.Application
  7.     Dim myNamespace As Namespace
  8.     Dim myFolder As MAPIFolder
  9.     Dim Folder As MAPIFolder
  10.     Dim iMail As Outlook.MailItem
  11.     Dim attFilename As String
  12.     Dim myAttachment As Outlook.Attachment
  13.     Dim mytmp As String
  14.     Dim tmpa As String
  15.     Application.DisplayAlerts = False
  16.     Application.AskToUpdateLinks = False
  17.     Application.ScreenUpdating = False
  18.     '//  Set outApp = GetObject("outlook.Application")

  19.     '
  20.     Set outApp = New Outlook.Application
  21.     Set myNamespace = outApp.GetNamespace("MAPI")
  22.     'Set myFolder = MyNameSpace.PickFolder
  23.     Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)    '//获得收件箱文件夹
  24.     For Each iMail In myFolder.Items
  25.     Call GetUnReadMail(iMail, myFolder.Name)
  26.     Next iMai

  27.     '//数据清零

  28.     Application.DisplayAlerts = True
  29.     Application.AskToUpdateLinks = True
  30.     Application.ScreenUpdating = True
  31.     Set iMail = Nothing
  32.     Set myFolder = Nothing
  33.     Set myNamespace = Nothing
  34.     Set outApp = Nothing
  35. End Sub
  36. Sub GetUnReadMail(myMail As Outlook.MailItem, myFolderName As String)
  37.     Dim attFilename As String
  38.     Dim tmpa As String
  39.     Dim mytmp As String
  40.     '创建邮件体

  41.     myForwardHTMLBody = CreateHTMLBody(2)
  42.     If myMail.UnRead Then
  43.         Set myAutoForwardMailItem = myMail.ReplyAll
  44.         MsgBox myMail.SenderEmailAddress
  45.         '设置收件人

  46.         myAutoForwardMailItem.Recipients.Add "417149126@qq.com"
  47.         rcvhtmlBody = myMail.HTMLBody
  48.         rcvBody = myMail.Body
  49.         mto = myMail.To
  50.         '设置邮件体格式为outlook html格式
  51.         myAutoForwardMailItem.BodyFormat = olFormatHTML
  52.         '将原始邮件与新邮件连起来
  53.         myAutoForwardMailItem.To = mto
  54.         myAutoForwardMailItem.HTMLBody = myForwardHTMLBody & myAutoForwardMailItem.HTMLBody
  55.         myAutoForwardMailItem.Send
  56.         myMail.Save
  57.     End If

  58. End Sub

  59. Public Function CreateHTMLBody(id As Integer) As String
  60.     'Creates a new e-mail item and modifies its properties
  61.     Dim objHTMLBody As String
  62.     '可以设置多个模板
  63.     If id = 1 Then
  64.         objHTMLBody = _
  65.         "<font face = 微软雅黑 size = 3>" & _
  66.         "感谢你的来信。我是<font color=red>机器人小星</font>,邮件我已代为阅读。" & _
  67.         "<br/> <br/> " & _
  68.         "来自小星的智能转发</font>"
  69.     ElseIf id = 2 Then
  70.         objHTMLBody = _
  71.         "<table style = border-collapse:collapse <tbody>" & _
  72.         "<tr><td style = border:1px solid #B0B0B0 colspan= 2>版本</td></tr>" & _
  73.         "<tr><td style= border:1px solid #B0B0B0 >APP版本</td></tr>" & _
  74.         "<tr><td style = border:1px solid #B0B0B0>SDK版本</td></tr>" & _
  75.         "</tbody></table>" & _
  76.         "" & _
  77.         "<br/> <br/> " & _
  78.         "来自小星的智能回复</font>"
  79.     End If
  80.     CreateHTMLBody = objHTMLBody
  81. End Function
复制代码


评分

参与人数 1经验 +30 收起 理由
roych + 30 (技术)原创精品课程、录像、代码、教程

查看全部评分

您需要登录后才可以回帖 登录 | 注册

本版积分规则

关闭

站长推荐上一条 /6 下一条

QQ|站长邮箱|小黑屋|手机版|Office中国/Access中国 ( 粤ICP备10043721号-1 )  

GMT+8, 2019-5-27 14:09 , Processed in 0.088906 second(s), 31 queries .

Powered by Discuz! X3.3

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表