Outlook

 Option Explicit

Dim outlook, namespace, inbox, ppoFolder, completedFolder

Dim items, mail, i, subjectMatch, receivedToday, savePath, attachment

Dim fs, todayDate, shell

Set shell = CreateObject("WScript.Shell")

' Save path for attachments (change as needed)

savePath = "C:\DownloadedAttachments\"  ' <-- Change this

' Today's date

todayDate = Date

Set fs = CreateObject("Scripting.FileSystemObject")

If Not fs.FolderExists(savePath) Then fs.CreateFolder(savePath)

Set outlook = CreateObject("Outlook.Application")

Set namespace = outlook.GetNamespace("MAPI")

Set inbox = namespace.GetDefaultFolder(6) ' 6 = Inbox

' Get Inbox\PPO folder

Set ppoFolder = inbox.Folders("PPO")

If ppoFolder Is Nothing Then

    shell.Popup "PPO folder not found inside Inbox.", 3, "Error", 48

    WScript.Quit

End If

' Get Inbox\Completed folder

Set completedFolder = inbox.Folders("Completed")

If completedFolder Is Nothing Then

    shell.Popup "Completed folder not found inside Inbox.", 3, "Error", 48

    WScript.Quit

End If

Set items = ppoFolder.Items

items.Sort "[ReceivedTime]", True

Dim mailCount

mailCount = 0

For i = items.Count To 1 Step -1

    If TypeName(items(i)) = "MailItem" Then

        Set mail = items(i)

        subjectMatch = InStr(1, mail.Subject, "BCVV", vbTextCompare) > 0

        receivedToday = (DateValue(mail.ReceivedTime) = todayDate)

        If subjectMatch And receivedToday Then

            ' Download attachments

            If mail.Attachments.Count > 0 Then

                For Each attachment In mail.Attachments

                    attachment.SaveAsFile savePath & attachment.FileName

                Next

            End If

            ' Mark as read

            mail.UnRead = False

            ' Move to Completed folder

            mail.Move completedFolder

            mailCount = mailCount + 1

        End If

    End If

Next

shell.Popup "Processing completed successfully. " & mailCount & " mail(s) handled.", 3, "Done", 64