Automatically Save Attachments From Specific Sender or Domain or Subject in Outlook with VBA

Public WithEvents objInboxItems As Outlook.Items

Private Sub Application_Startup()
   Set objInboxItems = Session.GetDefaultFolder(olFolderInbox).Items
End Sub  
Private Sub objInboxItems_ItemAdd(ByVal Item As Object)
   If Item.Class = olMail Then
    Dim objMail As Outlook.MailItem
    Dim objAttachment As Attachment
    Set objMail = Item
   
    Dim objSubjectStr As String, objBodyStr As String, objSenderAddressStr As String
    objSubjectStr = objMail.Subject
    objBodyStr = objMail.Body
    objSenderAddressStr = GetSenderAddrStr(objMail)

    ''''Download Scanner Images''''
    Dim strScannerSender As String, strFolderPath As String, strSubject As String

    strScannerSender = "ALSVN.IT@ALSGlobal.com" '"Bradley.Vanderleeuw@ALSGlobal.com"
    strSubject = "Message from KM_C3320i"
    strFolderPath = "\\NAWHTWS002\Bradley.Vanderleeuw$\MyDocuments\Scanned Docs\"

     If objSenderAddressStr = strScannerSender And objMail.Attachments.Count > 0 And objSubjectStr = strSubject Then
      For Each objAttachment In objMail.Attachments
       objAttachment.SaveAsFile strFolderPath & objAttachment.FileName
      Next
      objMail.UnRead = False
      objMail.Delete
     End If
    ''''Download Scanner Images''''
   End If
End Sub
Public Function GetSenderAddrStr(objMail As Outlook.MailItem) As String
 If objMail.SenderEmailType = "SMTP" Then
        GetSenderAddrStr = objMail.SenderEmailAddress
 Else
        GetSenderAddrStr = objMail.Sender.GetExchangeUser().PrimarySmtpAddress
 End If
End Function