保存附件并使用电子邮件主题的名称创建子文件夹

Question

我创建了一条规则，将电子邮件移动到名为＆＃34;传出＆＃34;的子文件夹中。和＃34;传入的评论＆＃34;。我需要将附件提取到以电子邮件主题命名的自动创建的本地硬盘子文件夹中。

本地驱动器是F：\ Outgoing

Answer 1

Option Explicit
Const folderPath = "f:\outgoing\"
Sub GetOutGoingAttachments()
On Error Resume Next
Dim ns As NameSpace
Set ns = GetNamespace("MAPI")
Dim Inbox As MAPIFolder
Set Inbox = ns.GetDefaultFolder(olFolderInbox)

Dim searchFolder As String
searchFolder = InputBox("Search for Outgoing Reports?")

Dim Subfolder As MAPIFolder

Dim Item As Object
Dim Attach As Attachment
Dim FileName As String
Dim i As Integer



If searchFolder <> "inbox" Then
Set Subfolder = Inbox.Folders(searchFolder)
            i = 0
            If Subfolder.Items.Count = 0 Then
               MsgBox "There are no messages in the Inbox.", vbInformation, _
                      "Nothing Found"
               Exit Sub
            End If
                    For Each Item In Subfolder.Items
                       For Each Attach In Item.Attachments
'
                         Attach.SaveAsFile (folderPath & Attach.FileName)

                          i = i + 1
                       Next Attach
                    Next Item

                    '==============================================================================
                        'to search specific type of file:
'                                    'For Each Item In Inbox.Items
'                                   For Each Atmt In Item.Attachments
'                                      If Right(Atmt.FileName, 3) = "xls" Then
'                                         FileName = "C:\Email Attachments\" & Atmt.FileName
'                                         Atmt.SaveAsFile FileName
'                                         i = i + 1
'                                      End If
'                                   Next Atmt
'                                Next Item
                    '===============================================================================

        Else
         i = 0
            If Inbox.Items.Count = 0 Then
               MsgBox "There are no messages in the Inbox.", vbInformation, _
                      "Nothing Found"
               Exit Sub
            End If
            On Error Resume Next
            For Each Item In Inbox.Items
               For Each Attach In Item.Attachments
                  FileName = folderPath & Attach.FileName
                  Attach.SaveAsFile FileName
                   i = i + 1
               Next Attach
            Next Item
     End If

End Sub

Answer 2

循环访问Folder.Items集合并从集合中的每个项目获取MailItem对象。然后为每个MailItem，为MailItem.Attachments中的每个对象调用Attachment.SaveAsFile。