説明:
指定のOutlookフォルダ”mailfolder”を開く
mailを後方から順番に開いて、
mailタイトルが”TEST:”で始まるかチェック
添付ファイルを指定のフォルダ”BASE_PATH”に保管してmailを削除

Const BASE_PATH As String = "c:\temp\mail\"
    
Sub export_attached_file()
    Dim myOlApp As Object, myNameSpace As Object, myFolder As Object
    Dim MAX_MAIL As Long
    Dim myItem As Object, myAttachments As Object
    Dim Title As String
        
    Title = "TEST:"
    
    Set myOlApp = CreateObject("Outlook.Application")
    Set myNameSpace = myOlApp.GetNamespace("MAPI")
    'Set myFolder = myNameSpace.PickFolder　'毎回フォルダを選択させたい場合
    Set myFolder = myNameSpace.Folders("mailfolder") 'mailのフォルダ指定
    
    MAX_MAIL = myFolder.Items.Count
    Open BASE_PATH & "index_ZIP.txt" For Output As #1
        
    For j = MAX_MAIL To 1 Step -1
        'Debug.Print J
        Set myItem = myFolder.Items(j)
        Set myAttachments = myItem.Attachments
        
        '添付フアィルの数をカウント
        cu = myAttachments.Count
        
        If Left(myItem.Subject, Len(Title)) = Title Then
        
            'ファイルを保存
            For i = 1 To cu
                FN = BASE_PATH & myAttachments.Item(i).DisplayName
                myAttachments.Item(i).SaveAsFile FN
                Print #1, FN
            Next i
            myItem.Delete 'mail delete
        
        End If
        Debug.Print j
        DoEvents
    Next
    Close
    
    MsgBox "done!"

End Sub