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
