zoukankan      html  css  js  c++  java
  • 20170711筛选OutLook主题并转发

    Sub 筛选OutLook主题并转发()
        On Error Resume Next
        Dim OutApp As Application
        Set OutApp = Application
        Dim OutMail As MailItem
        Dim OneAccount As Account
        Dim UsingAccount As Account
        Dim OutNameSpace As NameSpace
        Dim OneFolder As Folder
        Dim subFolder As Folder
        Dim OneBody As String
        Dim ToName As String
        Dim FwdItem As MailItem
        Dim NewBody As String
    
        '要在OutLook里配置一个POP3的账户 用来发送邮件
        For Each OneAccount In Application.Session.Accounts
            If OneAccount.AccountType = olPop3 Then
                Set UsingAccount = OneAccount    '找到账户
                Debug.Print "测试账户>>"; UsingAccount.UserName
                Exit For
            End If
        Next OneAccount
    
    
        Set OutNameSpace = OutApp.GetNamespace("MAPI")
        For Each OneFolder In OutNameSpace.Folders
    
            If OneFolder.Name = "next@126.com" Then    '此处改为你收件OutLook的账户名(就是收到对不起XXX的那个邮箱名称)
                For Each subFolder In OneFolder.Folders    '循环所有的文件夹
                    For Each OutMail In subFolder.Items    '循环所有邮件
                        Debug.Print OutMail.Subject
                        If InStr(1, OutMail.Subject, "对不起") > 0 Then    '如果标题含有对不起三个字
                            ToName = Split(outMailSubject, "-")(0)    '对不起,XXX后面是什么符号,  引号内则填什么符号  比如横杠-
                            ToName = Split(ToName, ",")(1)    '对不起和XXX之间什么符号,引号内就填什么符号 比如中文 逗号,
    
    
    
                            Set FwdItem = OutMail.Forward    '转发
    
                            '构建新的邮件内容
                            NewBody = "Hello " & ToName & vbCrLf
                            NewBody = NewBody & "        Your payment to " & ToName & " is declined" & vbCrLf
                            NewBody = NewBody & "Hi hi" & vbCrLf
                            NewBody = NewBody & FwdItem.Body
    
    
                            FwdItem.Recipients.Add ("8485@qq.com")    '填写转发地址
                            FwdItem.Recipients.Add ("7866@qq.com")    '添加更多的转发地址 就再复制一行
                            FwdItem.Subject = "Hello " & ToName  '转发的标题
                            FwdItem.Body = NewBody    '转发的内容
                            FwdItem.SendUsingAccount = UsingAccount    '发送使用的账户
                            FwdItem.Send    '发送
    
                        End If
                    Next
                Next
            End If
        Next
    
        Set OutApp = Nothing
        Set OutNameSpace = Nothing
        Set OutMail = Nothing
        Set OneFolder = Nothing
        Set subFolder = Nothing
        Set UsingAccount = Nothing
    End Sub
    

      

  • 相关阅读:
    更新部分字段 NHibernate
    无法显示 XML 页。 使用 XSL 样式表无法查看 XML 输入。请更正错误然后单击 刷新按钮,或以后重试的解决办法
    初识使用Apache MINA 开发高性能网络应用程序
    生产者消费者问题理解与Java实现
    国内HTML5前段开发框架汇总
    mongodb的sharding架构搭建
    spring配置声明式事务
    如何设计页面固定广告的效果
    结合实际问题浅谈如何使用蒙特卡罗算法模拟投资分析
    多线程实现资源共享的问题学习与总结
  • 原文地址:https://www.cnblogs.com/nextseven/p/7148852.html
Copyright © 2011-2022 走看看