从发件人下载文本文件附件，并将消息移动到子文件夹

Question

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

我找到了一个脚本下载和保存附件，并将其附加到一个规则。它可以工作，但我不能使用规则将电子邮件移动到子文件夹，因为它会在下载之前自动插入移动。

另一种方法是将下载和移动合并到一个脚本中，从而使脚本更复杂。

我发现了几个移动消息的示例代码，但我需要规则只移动具有txt文件附件和来自特定电子邮件地址的消息，我没有能力适应这一点。

Public Sub SaveAutoAttach(item As Outlook.MailItem)

Dim object_attachment As Outlook.Attachment
Dim saveFolder As String
saveFolder = "P:Shared WorksCatch 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 

Code I found在整个文件夹中搜索匹配条件，然后移动消息。我需要现有的代码来移动已在现有脚本中标识的项目。

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

然后你可以简单地保存你的邮件项目如下…

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 WorksCatch 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

非常感谢Domenic!!