Sub InboxItemsMove1(Item As Outlook.MailItem)
' Заготавливаем переменые для циклов
Dim mi As MailItem
Dim a As Attachment

Dim objNS As NameSpace
Dim objInbox As MAPIFolder
Dim objToFolder As MAPIFolder
' Получаем папку КУДА перемещать сразу и потом только используем её
Set objNS = Application.GetNamespace("MAPI")
Set objInbox = objNS.GetDefaultFolder(olFolderInbox)
Set objToFolder = objInbox.Folders("test")
' Проверяем, если есть папка-получатель, работаем
If Not objToFolder Is Nothing Then
' БегЁм по всем Итемам почты во входящей папке
    For Each mi In objInbox.Items
    ' Смотрим в Output'e темы сообщений, если интересно :)
        Debug.Print mi.Subject
    ' Здесь бегЁм по всем вложениям текущего почтового Итема
        For Each a In mi.Attachments
        ' Проверяем расширение и первые три символа имени вложения
            If Right(a.DisplayName, 4) = ".arj" And Left(a.DisplayName, 3) = "160" Then
                'On Error Resume Next
                ' И если мы прошли этот квест, тогда копируем сообщение с вложением в папку-получатель
                a.Copy objToFolder
            End If ' If Right(a.DisplayName, 4) = ".arj" And Left(a.DisplayName, 3) = "160" Then
        Next a ' For Each a In mi.Attachments
    Next mi ' For Each mi In objInbox.Items
End If ' If Not objToFolder Is Nothing Then

Set objToFolder = Nothing
Set objInbox = Nothing
Set objNS = Nothing
Set a = Nothing
Set mi = Nothing
End Sub