【Access示例】批量读取OutLook里的附件并保存到指定文件夹-will.miao
Access软件网QQ交流学习群(群号码198465573),欢迎您的加入!
首页 >技术文章> Access数据库-窗体/数据页


【Access示例】批量读取OutLook里的附件并保存到指定文件夹

发表时间:2018/3/25 13:13:25 评论(1) 浏览(11575)  评论 | 加入收藏 | 复制
   
摘 要:有时候,我们在工作中会收到许多统一内容的邮件,比如生产数据,报名表等,但一个一个的导出太麻烦了,那有什么办法来快速的导出这些邮件的附件呢?
正 文:

点击下载此附件


代   码:

Dim myFilter As String
    Dim folder As String
    Dim myOlApp As Object
    Dim myNamespace As Object    ' Outlook.NameSpace
    Dim myFolder As Object    ' Outlook.folder
    Dim mymailitem As Variant
    Dim att As Variant
    Dim Path As String
    myFilter = InputBox("请输入邮件标题的过滤关键字:", , "测试")
    folder = InputBox("请输入邮件附件的保存目录:", , "D:\新建文件夹")
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNamespace = myOlApp.GetNamespace("MAPI")
    Set myFolder = myNamespace.GetDefaultFolder(6) 
    For Each mymailitem In myFolder.Items
        If mymailitem.UnRead Then
            If InStr(mymailitem.Subject, myFilter) Then
                mymailitem.UnRead = False
                If mymailitem.Attachments.Count > 0 Then
                    For Each att In mymailitem.Attachments
                        Path = folder & "\" & mymailitem.Subject & "-" & att.FileName
                        Debug.Print Path
                        att.SaveAsFile Path
                    Next
                Else
                    MsgBox mymailitem.SenderEmailAddress & "无附件"
                End If
            End If
        End If
    Next
    MsgBox "完工了"


演   示:


Access软件网交流QQ群(群号:198465573)
 
 相关文章
【Access基础】如何快速启动OutLook  【缪炜  2014/12/28】
【Access示例】通过outlookup发送邮件(可以附带附件)  【缪炜  2015/2/20】
【Access示例】向OutLook中添加联系人  【缪炜  2015/4/10】
【Access示例】向OutLook中添加日历条目  【缪炜  2015/4/19】
选项组treeView 动态添加图片仿outlook样式菜单  【yuhong  2016/9/9】
outlook2010怎么设置  【杨雪  2017/5/12】
常见问答
技术分类
相关资源
文章搜索
关于作者

will.miao

文章分类

文章存档

友情链接