VBA：仅在本地文件夹中保存最后一个（最近的）电子邮件附件

我需要将上一封具有特定主题（最近一封）的电子邮件的附件保存到本地文件夹中，为此，我在Outlook中创建了一个文件夹，并创建了一个规则，用于将每个具有特定主题的电子邮件发送到此文件夹中。我发现了一个代码，它可以满足我的需要，只不过它可以保存电子邮件文件夹中的每个附件，而不是只保存最近的附件。这是代码：我如何修改它，使其满足我的需要

   Sub Test()
   'Arg 1 = Folder name of folder inside your Inbox
   'Arg 2 = File extension, "" is every file
   'Arg 3 = Save folder, "C:\Users\Ron\test" or ""
   '        If you use "" it will create a date/time stamped folder for you in your "Documents" folder
'        Note: If you use this "C:\Users\Ron\test" the folder must exist.

    SaveEmailAttachmentsToFolder "Dependencia Financiera", "xls", "W:\dependencia financiera\test dependencia\"

End Sub



Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox As String, _
                                 ExtString As String, DestFolder As String)
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim SubFolder As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim MyDocPath As String
    Dim i As Integer
    Dim wsh As Object
    Dim fs As Object

    On Error GoTo ThisMacro_err

    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set SubFolder = Inbox.Folders(OutlookFolderInInbox)

    i = 0
    ' Check subfolder for messages and exit of none found
    If SubFolder.Items.Count = 0 Then
        MsgBox "There are no messages in this folder : " & OutlookFolderInInbox, _
               vbInformation, "Nothing Found"
        Set SubFolder = Nothing
        Set Inbox = Nothing
        Set ns = Nothing
        Exit Sub
    End If

    'Create DestFolder if DestFolder = ""
   ' If DestFolder = "" Then
       ' Set wsh = CreateObject("WScript.Shell")
       ' Set fs = CreateObject("Scripting.FileSystemObject")
       ' MyDocPath = wsh.SpecialFolders.Item("mydocuments")
       ' DestFolder = MyDocPath & "\" & Format(Now, "dd-mmm-yyyy hh-mm-ss")
       ' If Not fs.FolderExists(DestFolder) Then
            'fs.CreateFolder DestFolder
       ' End If
    'End If

    'If Right(DestFolder, 1) <> "\" Then
        'DestFolder = DestFolder & "\"
    'End If

    ' Check each message for attachments and extensions
    'JUST BEED TGE FIRST EMAIL
    'Debug.Print Item(1).SentOn

    For Each Item In SubFolder.Items
       For Each Atmt In Item.Attachments
            If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then
                FileName = DestFolder & Atmt.FileName
                Atmt.SaveAsFile FileName
                'I = I + 1
            End If
       Next Atmt
   Next Item

    ' Show this message when Finished
   ' If I > 0 Then
       ' MsgBox "You can find the files here : " _
             & DestFolder, vbInformation, "Finished!"
   ' Else
       ' MsgBox "No attached files in your mail.", vbInformation, "Finished!"
   ' End If

    ' Clear memory
ThisMacro_exit:
    Set SubFolder = Nothing
    Set Inbox = Nothing
    Set ns = Nothing
    Set fs = Nothing
    Set wsh = Nothing
    Exit Sub

    ' Error information
ThisMacro_err:
    MsgBox "An unexpected error has occurred." _
         & vbCrLf & "Please note and report the following information." _
         & vbCrLf & "Macro Name: SaveEmailAttachmentsToFolder" _
         & vbCrLf & "Error Number: " & Err.Number _
         & vbCrLf & "Error Description: " & Err.Description _
         , vbCritical, "Error!"
    Resume ThisMacro_exit

End Sub

子测试（）
'Arg 1=收件箱中文件夹的文件夹名称
“Arg 2=文件扩展名”“是每个文件的扩展名
'Arg 3=保存文件夹，'C:\Users\Ron\test'或“”
'如果使用“”，它将在“文档”文件夹中为您创建一个带有日期/时间戳的文件夹
'注意：如果使用此“C:\Users\Ron\test”，则文件夹必须存在。
SaveEmailAttachmentsToFolder“Dependencia Financia”、“xls”、“W:\Dependencia Financia\test Dependencia\”
端接头
子SaveEmailAttachmentsToFolder（OutlookFolderInBox作为字符串_
ExtString作为字符串，DestFolder作为字符串）
Dim ns作为名称空间
将收件箱设置为MAPI文件夹
将子文件夹变暗为MAPIFolder
将项目变暗为对象
作为附件的Dim Atmt
将文件名设置为字符串
将MyDocPath设置为字符串
作为整数的Dim i
将wsh设置为对象
作为对象的Dim fs
错误时转到此宏\u错误
设置ns=GetNamespace（“MAPI”）
设置收件箱=ns.GetDefaultFolder（olFolderInbox）
设置子文件夹=收件箱。文件夹（OutlookFolderInBox）
i=0
'检查子文件夹中是否有消息，并退出“未找到”
如果子文件夹.Items.Count=0，则
MsgBox“此文件夹中没有邮件：”&OutlookFolderInBox_
VBA信息，“未找到任何内容”
设置子文件夹=无
设置收件箱=无
设置ns=无
出口接头
如果结束
'如果DestFolder=“”则创建DestFolder“”
'如果DestFolder=“”，则
'Set wsh=CreateObject（“WScript.Shell”）
'Set fs=CreateObject（“Scripting.FileSystemObject”）
'MyDocPath=wsh.SpecialFolders.Item（“mydocuments”）
'DestFolder=MyDocPath&“\”格式（现在为“dd-mmm-yyy-hh-mm-ss”）
'如果不是fs.FolderExists（DestFolder），则
'fs.CreateFolder DestFolder
"完"
"完"
'如果正确（DestFolder，1）“\”则
'DestFolder=DestFolder&'\'
"完"
'检查每封邮件的附件和扩展名
刚收到第一封电子邮件
'Debug.Print项（1）.SentOn
对于子文件夹中的每个项。项
对于项目附件中的每个Atmt
如果LCase（Right（Atmt.FileName，Len（ExtString））=LCase（ExtString），那么
FileName=DestFolder&Atmt.FileName
Atmt.SaveAsFile文件名
‘I=I+1
如果结束
下一个Atmt
下一项
'完成后显示此消息
'如果我>0，那么
“MsgBox”您可以在此处找到文件：_
&DestFolder，vbInformation，“完成！”
”“否则呢
'MsgBox“邮件中没有附件。”，vbInformation，“已完成！”
"完"
“清除内存
此宏_退出：
设置子文件夹=无
设置收件箱=无
设置ns=无
设置fs=Nothing
设置wsh=Nothing
出口接头
'错误信息
此宏错误：
MsgBox“发生意外错误。”_
&vbCrLf&“请注意并报告以下信息。”_
&vbCrLf&“宏名称：SaveEmailAttachmentsToFolder”_
&vbCrLf&“错误编号：”&错误编号_
&vbCrLf&“错误描述：”&错误描述_
，vbCritical，“错误！”
继续此宏。\u退出
端接头

您可以试试这个

Sub SaveEmailAttachmentsToFolder(OutlookFolderInInbox As String, _
                                 ExtString As String, DestFolder As String)

    Dim ns As Namespace
    Dim Inbox As Folder
    Dim SubFolder As Folder

    Dim subFolderItems As Items

    Dim Atmt As attachment

    Dim FileName As String

    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    Set SubFolder = Inbox.Folders(OutlookFolderInInbox)

    Set subFolderItems = SubFolder.Items

    If subFolderItems.count > 0 Then

        subFolderItems.Sort "[ReceivedTime]", True

        For Each Atmt In subFolderItems(1).Attachments
            If LCase(Right(Atmt.FileName, Len(ExtString))) = LCase(ExtString) Then
                FileName = DestFolder & Atmt.FileName
                Atmt.SaveAsFile FileName
            End If
        Next Atmt

    End If

    ' Clear memory
ThisMacro_exit:
    Set SubFolder = Nothing
    Set Inbox = Nothing
    Set ns = Nothing
    Set subFolderItems = Nothing

End Sub

---

考虑ItemAdd。最近的项目已为人所知

将其标记为答案，以便每个人都知道其已关闭（并给予响应者信任）