ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 效率神器,一键搞定繁琐工作
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
让更多数据处理,一键完成 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 4943|回复: 5

[求助] 如何把outlook邮件的附件存到指定路径里

[复制链接]

TA的精华主题

TA的得分主题

发表于 2013-8-7 22:44 | 显示全部楼层 |阅读模式
应该是写个VBA宏,然后用规则设置,运行脚本即可。哪位大侠给写个代码啊?

TA的精华主题

TA的得分主题

 楼主| 发表于 2013-8-9 17:36 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2013-8-27 16:51 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2013-8-18 20:59 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2013-9-29 15:45 | 显示全部楼层
可以 的

我刚刚玩完
  1.   Sub NewMailSaveAttachemnets()

  2. '// outlook 所指定的邮件 自动答复指定的人
  3. '//内容固定的

  4.     Dim mail As Outlook.MailItem

  5.     Dim Fso As Object

  6.     Dim myOlExp As Outlook.Explorer                   '//outlook
  7.     Dim myOlSel As Outlook.Selection                  '//outlook所在选择项
  8.     Set Fso = CreateObject("Scripting.FileSystemObject")    '//FSO文件对象
  9.     Dim MsgTxt As String
  10.     Dim x As Integer

  11.     Dim Folder As String
  12.     Dim reg As String

  13.     Dim MyFileName As String


  14.     Set myOlExp = Application.ActiveExplorer          '//指向对象


  15.     Set myOlSel = myOlExp.Selection

  16.     Dim vItem As Object

  17.     reg = "\d+"

  18.     For x = 1 To myOlSel.Count

  19.         If myOlSel.Item(x).Attachments.Count > 0 Then

  20.             For i = 1 To myOlSel.Item(x).Attachments.Count

  21.                 Set vItem = myOlSel.Item(x).Attachments(i)

  22.                 MyFileName = vItem.Subject

  23. Debug.Print MyFileName

  24.                 If InStr(MyFileName, "单") = 0 Then

  25.                     vItem.SaveAsFile "D:" & vItem.FileName    '//保存到另外一个文件夹

  26.                 Else
  27.                     '//判断是否包含该月份的文件夹,有则保存在文件夹 ,无则创建文件

  28.                     Folder = "D:\PDF文件\2013" & Val(Mid(getRegtoString(reg, MyFileName), 5, 2)) & "月份"

  29.                     If Not Fso.FolderExists("Folder") Then

  30.                         Fso.CreateFolder (Folder)

  31.                     End If

  32.                     vItem.SaveAsFile Folder & "" & vItem.FileName

  33.                 End If

  34.             Next i


  35.         End If
  36.     Next x

  37. End Sub
复制代码


TA的精华主题

TA的得分主题

发表于 2018-9-21 17:10 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-12-4 00:58 , Processed in 0.048584 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

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