outlook vba 插件

最新推荐文章于 2024-04-09 15:34:25 发布
最新推荐文章于 2024-04-09 15:34:25 发布
阅读量1.8k 收藏 2
点赞数
分类专栏： vba 文章标签： vba integer string application function object
版权声明：本文为博主原创文章，遵循 CC 4.0 BY-SA 版权协议，转载请附上原文出处链接和本声明。
本文链接：https://blog.csdn.net/weixu_2008/article/details/2071000
版权
' 定義された変数
Dim  DelAfterHandle  As   Boolean
Dim  Question, Reply, LogPath, DFMailList, strBody, strSubject, strUser  As   String
Option   Explicit

Private   Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)

End Sub
' 受信時の動作
Private   Sub Application_NewMailEx(ByVal EntryIDCollection As String)
    '---------------------------
    '自分定義data
    '処理完了後で削除falg　デフォルト状態は削除しない（目前は使用しない）
    DelAfterHandle = False
    '指定ログファイルパス
    LogPath = "E:MailRule"
    '内部係メールアドレスリスト
    DFMailList = ""
    '---------------------------
    '受信したメール
    Dim objMail As Object
    '発送や転送の新しいメール
    Dim NewMailItem As Outlook.MailItem
    'アドレスを追加用の変数
    Dim myRecipient As Outlook.Recipient
    Dim intBegin, intEnd, intLength As Integer
    Dim strEntryID As String
    
    intBegin = 1
    intLength = Len(EntryIDCollection)
    intEnd = InStr(intBegin, EntryIDCollection, ",")
    If intEnd = 0 Then intEnd = intLength + 1
    Do While intEnd <> 0
        strEntryID = Mid(EntryIDCollection, intBegin, (intEnd - intBegin))
        '受信の新しいメールを取得
        Set objMail = Application.Session.GetItemFromID(strEntryID)
            '送信アドレスによって、受信の新しいメールは内部からメールかどうかを判断
            strUser = objMail.SenderEmailAddress
            If InStr(1, DFMailList, objMail.SenderEmailAddress) <> 0 Then
                '内部アドレス場合、ユーザへ発送
                '件名は指定格式を満足かどうかを判断
                If GetSubjectAndUser(objMail.Subject) <> False Then
                    '件名は指定格式を満足すれば
                    '問題と答え内容を取得できるかどうかを判断
                    If GetAnswerAndReply(objMail.Body) <> False Then
                        '問題と答え内容を取得できれば
                        Set NewMailItem = Application.CreateItem(olMailItem)
                        strBody = objMail.HTMLBody
                        With NewMailItem
                            .BodyFormat = olFormatHTML
                            .HTMLBody = objMail.HTMLBody
                            .Subject = strSubject
                        End With
                        NewMailItem.Recipients.Add (strUser)
                        NewMailItem.Send
                        Open LogPath + "Logs.txt" For Append As #2
                        Print #2, "[" + Format(Now, "yyyy-mm-dd hh:mm:ss") + "]から" + objMail.SenderEmailAddress + "受信メール " + objMail.Subject + " という件もう代わりました！"
                        Close #2
                    Else
                        'もし問題と答え内容を取得できなければ、「答えメールの格式は指定格式を満足しない」というメールを発送
                        Call SendFormatErrorMail(objMail, "<HTML><BODY><H2>答えメールの格式は指定した格式と満足しない.</H2>格式は：<H2>Question:</H2><H2>Reply:</H2><H2>このメールは自動返信ですから、返信しないください</H2>")
                    End If
                Else
                    '件名は指定格式を満足しなければ
                    Call SendFormatErrorMail(objMail, "<HTML><BODY><H2>件名は指定した格式と満足しない.</H2><H2>格式は：「件名;ユーザのメールアドレス」。</H2><H2>このメールは自動返信ですから、返信しないください.</H2>")
                End If

            Else
                '外部アドレス場合、DFサポート者へ転送
                Call SendToDF(objMail)
            End If
        intBegin = intEnd + 1
        intEnd = InStr(intBegin, EntryIDCollection, ",")
    Loop
End Sub
' 答えメールの件名から新しい件名と対応ユーザのメールアドレスを取得
Private   Function GetSubjectAndUser(subjectstr As String) As Boolean
    Dim intPos As Integer
    intPos = InStr(1, subjectstr, ";")
    If intPos <> 0 Then
        '件名に「;」前の文字列は新しい件名
        strSubject = Mid(subjectstr, 1, intPos - 1)
        '件名に「;」後の文字列は対応ユーザのアドレス
        strUser = Mid(subjectstr, intPos + 1)
        'アドレスが有効かどうかを判断
        If InStr(1, strUser, "@") <> 0 Then
            GetSubjectAndUser = True
            Exit Function
        End If
    End If
    GetSubjectAndUser = False
    Exit Function
End Function
' 答えメールの内容から問題と答えを取得
Private   Function GetAnswerAndReply(bodystr As String) As Boolean
    GetAnswerAndReply = True
    Exit Function
End Function

Private   Sub SendToDF(objMail)
    'DFMailListからDFサポート者のメールアドレスを取得して、メールを転送する
    Dim intPos As Integer
    Dim oldPos As Integer
    Dim NewMailItem As Outlook.MailItem
    intPos = InStr(1, DFMailList, ";")
    Do While intPos <> 0
        strUser = Mid(DFMailList, oldPos + 1, intPos - 1 - oldPos)
        Set NewMailItem = Application.CreateItem(olMailItem)
        With NewMailItem
            .Body = objMail.Body
            .Subject = objMail.Subject + ";" + objMail.SenderEmailAddress
        End With
        NewMailItem.Recipients.Add (strUser)
        NewMailItem.Send
        oldPos = intPos
        intPos = InStr(intPos + 1, DFMailList, ";")
    Loop
    strUser = Mid(DFMailList, oldPos + 1)
    Set NewMailItem = Application.CreateItem(olMailItem)
    With NewMailItem
        .Body = objMail.Body
        .Subject = objMail.Subject + ";" + objMail.SenderEmailAddress
    End With
    NewMailItem.Recipients.Add (strUser)
    NewMailItem.Send
    'ログファイルに書く込む
    Open LogPath + "Logs.txt" For Append As #1
    Print #1, "[" + Format(Now, "yyyy-mm-dd hh:mm:ss") + "]から" + objMail.SenderEmailAddress + "受信メール " + objMail.Subject + " という件はDFサポート者へ転送している！"
    Close #1
End Sub

Private   Sub SendFormatErrorMail(objMail, str)
    Dim NewMailItem As Outlook.MailItem
    Set NewMailItem = Application.CreateItem(olMailItem)
    With NewMailItem
        .BodyFormat = olFormatHTML
        .HTMLBody = str
        .Subject = objMail.Subject
    End With
    NewMailItem.Recipients.Add (objMail.SenderEmailAddress)
    NewMailItem.Send
    Open LogPath + "Logs.txt" For Append As #1
    Print #1, "[" + Format(Now, "yyyy-mm-dd hh:mm:ss") + "]から" + objMail.SenderEmailAddress + "受信メール " + objMail.Subject + " という件はstr！"
    Close #1
End Sub
 
weixu_2008
关注
  • 0
    点赞
  • 踩
  • 2
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
专栏目录
VB6 OUTLOOK 2007 插件源码
10-25
2. **Outlook Object Model**：Outlook对象模型是Outlook的编程接口，允许开发者通过VBA（Visual Basic for Applications）或其他支持的语言（如VB6）来访问和操作Outlook的各项功能，包括邮件、日历、联系人、任务...
outlook vba开发要点
CHJ_20160630的博客
09-23 547
1.学学基础的VB语法 https://www.yiibai.com/vba/vba_programming_charts.html 2.找一个样例看看 VBA编程实现自动回复邮件 https://blog.csdn.net/tclxspy/article/details/50714783 3.改造样例 取msdn上看看开发文档 https://docs.microsoft...
VB、VBS和VBA中使用outlook学习（一）
把工作变成娱乐
02-29 2432
一、初识「Outlook.Application」对象的使用转⇒演示如何在vb中创建一个新outlook任务---------------------------------------------------------------------演示如何创建一个新任务-----------------------------------------------------------
outlook vba 插件2
weixu_2008的专栏
03-05 1435
ThisOutlookSession文件VERSION 1.0 Class BEGINCLASSBEGIN  MultiUse = -1  TrueENDAttribute VB_Name = "ThisOutlookSession"Attribute VB_GlobalNameSpace = FalseAttribute VB_Creatable = FalseAttribute VB
VB6中處理OutLook文件夾的Module
weixin_30632883的博客
05-09 91
'********************************************************************''Description:按Treeview中的節點信息,讀取/添加到OutLook文件夾'================================================================'Name...
在 VBA 中，使用 Outlook 对象库可以访问和操作 Outlook 应用程序中的邮件项。下面是一些常见的与邮件相关的属性
QingYuanve的博客
06-28 2090
需要注意的是，你需要在 VBA 编辑器中的“工具”>“引用”中添加对“Microsoft Outlook XX.X 对象库”的引用（版本号根据你安装的 Outlook 版本而定）。在上述示例中，我们首先创建了 Outlook 应用程序对象（olApp），然后使用 CreateItem 方法创建了一个邮件对象（olMail）。在 VBA 中，使用 Outlook 对象库可以访问和操作 Outlook 应用程序中的邮件项。接下来，我们通过设置邮件对象的各个属性（如主题、正文、附件和收件人）来配置邮件。
使用VBA宏提高Outlook的效率和生产力(持续更新中)
felix_8的博客
03-04 946
使用VBA宏可以帮助您更快、更有效地使用Outlook，并提高您的工作效率和生产力。我希望这些实用技巧能帮助您更好地掌握这些工具，并提高您的Outlook体验
Outlook-VBA-01-开发环境介绍
Z的博客
06-27 2185
系统：Windows 10 软件：Outlook 2016 本系列讲讲在Outlook中使用VBA实现一些功能 例如邮件的自动处理 今天讲讲环境信息 Part 1：背景 之前在Excel中使用VBA实现了自动发邮件的功能，也是在Excel中引用了Outlook 但是对于某些场景，仅仅使用Excel这种方式还不行。如自动对每一封新邮件一些处理 Office的Outlook本身也是支持VBA的二次开发，所以一起来看看 Part 2：环境介绍 和Excel中打开开发环境类似。文件-选项-自定义功能区
Excel vba入门教程
08-13
掌握VBA后，不仅可以快速应用于Excel，还可以扩展到其他Microsoft Office应用程序，如Word、Access、Outlook等，实现跨平台的解决方案。 在Excel环境中使用VBA的优势在于： 1. **自动化重复任务**：可以编写宏来...
Office百宝箱 v29.0 【Excel、Word、PPT、Outlook、Publisher、VBA编程、办公必备插件】
05-03
当安装Office百宝箱后，分别会在Excel、Word、PowerPoint、Outlook、Publisher、Access、VBA编译器等的主程序界面将产生【万能百宝箱】菜单及相应的扩展功能菜单或函数。总共包括380多个子菜单，并在Excel 2016或者...
自动保存Outlook邮件的附件(利用VBA)
03-28
自动保存Outlook邮件的附件(利用VBA).docx
用VBA将outlook附件保存到本地电脑
11-05
利用VBA将outlook附件保存到本地电脑 支持 outlook 2003 2007 2010 2013
VBA解析outlook邮件
06-24
通过outlook自带的VBA宏解析outlook邮件，提取邮件的主题，抄送，正文等信息
VBA代码助手专业版3.7.8.0
06-05
主要功能： VBA代码库收藏管理, VBA中文代码库输入提示, VBA变量名首字母输入提示 VBA函数...Excel VBA代码助手,word VBA代码助手,ppt VBA代码助手,Outlook VBA代码助手,Access VBA代码助手,AutoCad VBA代码助手....
Outlook2007 ContextMenu
04-19
VSTO是微软提供的一种开发工具，允许开发者利用.NET Framework创建Office应用程序的自定义功能，如Outlook的插件或上下文菜单。 在Outlook 2007中，通过VSTO，开发者可以创建自定义的上下文菜单项，当用户右键点击...
VBA利用outlook发送邮件
m0_62417166的博客
01-29 1177
工具引用：Microsoft Outlook 16.0 Object Librar。
VBA使用Outlook自动发送邮件
热门推荐
Smilecoc的博客
06-28 1万+
利用VBA使用Outlook自动发送邮件，代码及注释如下： Sub send_mail() Dim ObjOL As Object Dim itmNewMail As Outlook.MailItem Dim mailaddress As String '引用Microsoft Outlook 对象 Set ObjOL = CreateObject("Outlook.Application") Set itmNewMail = ObjOL.CreateItem(olMailItem) '******输入
VBA 实现outlook 当邮件设置category: red 即触发自动创建jira issue
最新发布
com542948180的博客
04-09 855
4.可以点击上图View->Immediate Windows 查看debug的控制台输出,方便调试代码。1. 打开: Outlook VBA（Visual Basic for Applications）方法一: 在邮件直接搜索:Visual Basic editor。
#office#设置Outlook提醒无主题
u010197551的博客
04-10 1412
 可利用vb代码实现，步骤如下： 　　1、启动outlook后，按alt+F11，打开vbe窗口； 　　2、异常点击展开project1--Microsoft outlook对象--thisoutlooksession，右侧代码编辑区输入以下代码： 　　Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Bo
Outlook VBA自动化教程：邮件处理与应用
"HP OUTLOOK VBA的培训PPT提供了关于使用Outlook VBA实现邮件自动化处理的方法，包括邮件保存、附件操作、信息抓取、邮件生成与发送等。" 在Microsoft Outlook中，VBA（Visual Basic for Applications）是一种强大...
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值