Office中国论坛/Access中国论坛

标题: [原创] 小闻趣话之一获得邮件的中全部附件 [打印本页]
作者: 闻启学    时间: 2019-4-14 11:01
标题: [原创] 小闻趣话之一获得邮件的中全部附件
在某个单位办公室
上午9：50分，江少忽然被上司奉召到办公室；少刻，江少苦着面，捧住笔记本电脑从里面出来。急忙到座位边敲击键盘起来。
旁边斌哥打趣说到“江少，怎么啦。进去后变了天”，江少无奈讲“老佛爷让我将邮箱里邮件的附件全部保存下来！。在上午之前完成”，“老佛爷，是不是有点令人难做，不怕，找人帮你！”，“小闻，你过来” 小闻慢慢地过来了,"怎么啦"。“无，我们三个人分开任务，将邮箱里邮件的附件全部下载”
“斌哥，开玩笑，谁有本事将邮箱分三人共享”。小闻猫一眼笔记本电脑，自言自语地讲“幸好他用Outlook，还是完整版本，否则我无办法了”，回头对江少讲“帮你搞好，中午饭你请客”江少，斌哥讲 “肯定？”，小闻笑而不答。
  1. Sub GetAttachmentName()
  2. '//获得邮件中的附件
  3.     Dim OutApp As outlook.Application
  4.     Dim myNamespace As NameSpace
  5.     Dim myFolder As MAPIFolder
  6.     Dim Folder As MAPIFolder
  7.     Dim iMail As outlook.MailItem
  8.     Dim attFilename As String
  9.     Dim myAttachment As outlook.Attachment
  10.     Dim mytmp As String
  11.     Dim tmpa As String
  12.     On Error Resume Next
  13.     Dim ExcelApp
  14.     Set OutApp = New outlook.Application
  15.     Set myNamespace = OutApp.GetNamespace("MAPI")
  16.     'Set myFolder = MyNameSpace.PickFolder
  17.     Set myFolder = myNamespace.GetDefaultFolder(olFolderInbox)    '//获得收件箱文件夹

  19.     For i = 1 To myFolder.Folders.Count
  20.         Set Folder = myFolder.Folders(i)
  21.         For Each iMail In Folder.Items
  22.             For Each myAttachment In iMail.Attachments   '//获得邮件的附件
  23.                 attFilename = myAttachment.FileName
  24.                 If attFilename Like "*.xls?" Then  '//判断附件的类型
  25.                     tmpa = Split(attFilename, ".")(1)
  26.                     myAttachment.SaveAsFile "D:\邮件的附件" & attFilename    '//保存附件
  27.                 End If

  29.             Next
  30.         Next iMail
  31.     Next
  32.     Set iMail = Nothing
  33.     Set myFolder = Nothing
  34.     Set myNamespace = Nothing
  35.     Set Application = Nothing
  36. End Sub
复制代码








欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3