VBA - перемещение электронной почты на основе имени файла вложения

Question

Я пытаюсь написать макрос для перемещения электронной почты, если имя файла вложения соответствует строке (например, "asdfqwerty").Электронная почта будет перемещаться из папки «Входящие» в папку «Тест» в папке «Входящие».

Использование погашения, к сожалению, не вариант.

Любая помощь приветствуется!

Редактировать Вот мой обновленный код, основанный на советах от Дмитрия.Теперь я получаю сообщение об ошибке «Несоответствие типов» в самый последний файл «Далее» и не знаю, почему:

Sub SaveOlAttachments()
Dim olFolder As MAPIFolder
Dim olFolder2 As MAPIFolder
Dim msg As mailItem

Set olFolder = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
Set olFolder2 = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("Test")

For Each msg In olFolder.Items
    If msg.Class = 43 Then
        If msg.Attachments.Count > 0 Then
            If Left$(msg.Attachments(1).FileName, 10) = "asdfqwerty" Then
            msg.Move (oldFolder2)
            End If
        End If
    End If
Next
End Sub

Answer 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 

Answer 2

Вы пытались запустить этот код?В строке 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

Перед публикацией, по крайней мере, попытайтесь приложить некоторые усилия кубедитесь, что ваш код компилируется и, возможно, даже работает.Не ожидайте, что другие люди сделают это для вас.