vba 从 Outlook 中的发件人下载文本文件附件并将邮件移动到子文件夹

Question

每天我们都会收到一个带有几个文本文件附件的 email。 我想将附件下载到服务器上的一个文件夹中，然后将email邮件移动到Outlook中的一个子文件夹中。

我找到了一个用于下载和保存附件（如下）的简单脚本，并将其附加到规则中。 它运作良好。 但是我不能使用规则将 email 移动到子文件夹，因为它会在下载前自动插入移动，这是行不通的（脚本将不会运行，或者，如果您在子文件夹上运行它，它将下载数以千计的 txt 文件可以追溯到几年前。）。

另一种方法是通过将下载和移动合并到一个脚本中来使脚本更加复杂。 但我不知道该怎么做。 我找到了几个用于移动消息的示例代码，但我需要规则来仅移动具有 txt 文件附件和来自特定 email 地址的消息，但我没有能力适应它。

代码是：

Public Sub SaveAutoAttach(item As Outlook.MailItem)
 
Dim object_attachment As Outlook.Attachment
Dim saveFolder As String

saveFolder = "P:\Shared Works\Catch Reports"
 
    For Each object_attachment In item.Attachments
    If InStr(object_attachment.DisplayName, ".txt") Then
 
        object_attachment.SaveAsFile saveFolder & "\" & object_attachment.DisplayName
 
    End If
 
    Next
 
End Sub 

如果有人对如何调整此代码以实现上述目标有任何建议，我将不胜感激。

我发现的大多数代码都在整个文件夹中搜索匹配条件，然后移动邮件。 我只需要现有代码来移动现有脚本中已识别的项目。

Answer 1

在您的代码保存附件并退出For Each/Next循环后，首先定义您的移动文件夹（我假设您的文件夹名为 MyFolder 并且是默认收件箱中的子文件夹）...

Dim saveToFolder As Outlook.MAPIFolder
Set saveToFolder = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("MyFolder") 'change the name of your destination folder accordingly

然后你可以简单地保存你的 email 项目如下...

item.Move saveToFolder

Answer 2

OMG，它有效。：我在代码的错误部分设置了定义。 最终结果是：

Public Sub SaveAutoAttach(item As Outlook.MailItem)
 
Dim object_attachment As Outlook.Attachment
Dim saveFolder As String
Dim DestFolder As Outlook.Folder

' Folder location when I want to save my file
saveFolder = "P:\Shared Works\Catch Reports"
 
    For Each object_attachment In item.Attachments
    
    Dim saveToFolder As Outlook.MAPIFolder
    Set saveToFolder = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Catch Reports") 'change the name of your destination folder accordingly

    If InStr(object_attachment.DisplayName, ".txt") Then
 
        object_attachment.SaveAsFile saveFolder & "\" & object_attachment.DisplayName
 
    End If
    Next
    
    item.Move saveToFolder
  
End Sub

非常感谢多梅尼克！！！