[原创] 小闻趣话之一获得邮件的中全部附件

闻启学

在某个单位办公室
上午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)    '//获得收件箱文件夹
    
18. 
    
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
    
28. 
    
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

复制代码