VBA-根据附件文件名移动电子邮件

时间:2018-10-19 17:40:24

标签: vba outlook outlook-vba

如果附件文件名与字符串匹配(例如,“ asdfqwerty”),我试图编写一个宏来移动电子邮件。电子邮件将从我的收件箱移到我的收件箱下的文件夹“测试”。

不幸的是,不能使用“兑换”。

感谢您的帮助!

修改 这是我根据Dmitry的提示更新的代码。我现在在最后一个Next上遇到“类型不匹配”错误,并且不确定原因:

a ~ b

2 个答案:

答案 0 :(得分:0)

您是否尝试运行该代码?它将在msg.Attachments > 0行上出错。您需要msg.Attachments.Count > 0

下一行也不会运行-您需要遍历msg.Attachments集合中的所有附件:

for each attach in msg.Attachments
  if InStr(attach.FileName, "asdfqwerty") Then
     msg.Move (olFolder2)
     Exit for
  End If
next

在发布之前,请至少尝试付出一些努力,以确保您的代码可以编译甚至可以运行。不要期望其他人为您做到这一点。

答案 1 :(得分:-1)

带有附件的电子邮件进入,并且规则执行以下VBA脚本:

Sub Test() 

'Declaration 
Dim myItems, myItem, myAttachments, myAttachment As Object 
Dim myOrt As String 
Dim myFin As String 
Dim myOlApp As New Outlook.Application 
Dim myOlExp As Outlook.Explorer 
Dim myOlSel As Outlook.Selection 

'Ask for destination folder 
myOrt = "W:\" 

On Error Resume Next 

'work on selected items 
Set myOlExp = myOlApp.ActiveExplorer 
Set myOlSel = myOlExp.Selection 

'for all items do... 
For Each myItem In myOlSel 

'point on attachments 
Set myAttachments = myItem.Attachments 

'if there are some... 
If myAttachments.Count > 0 Then 


'for all attachments do... 
For i = 1 To myAttachments.Count 

'Ask for destination folder 
myFin = InputBox("Please type a filename below:", "Saving 
recording...", "") 

'save them to destination 
myAttachments(i).SaveAsFile myOrt & _ 
myFin 

Next i 
End If 
Next 
End Sub