[Outlook]VBA script for Outlook

Question

Hello,

I work at "@mycompany.com" and I need a VBA macro to move all emails that are not from "@mycompany.com".

What I have attempted:

• I tried creating a new rule but Outlook rule does not accept a wildcard (source: https://answers.microsoft.com/en-us/outlook_com/forum/all/is-it-possible-to-include-a-wildcard-in-the-rules/dee5b17b-ca13-49f6-80b2-1f5335eb143a).
• I tried using a VBA macro, which I have provided below, but it is not working.

Can anyone please advise?

Private WithEvents Items As Outlook.Items
Private Explorer As Outlook.Explorer

Private Sub Application_Startup()
' Reference the items in the Inbox
Set Items = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Items
' Get the current Explorer
Set Explorer = Application.ActiveExplorer
' Collapse the "Archive" folder
CollapseArchiveFolder
End Sub

Private Sub CollapseArchiveFolder()
Dim ns As Outlook.NameSpace
Dim archiveFolder As Outlook.folder
Set ns = Application.GetNamespace("MAPI")
On Error Resume Next
Set archiveFolder = ns.Folders("myalias@mycomapny.com).Folders("Archive")
On Error GoTo 0
If Not archiveFolder Is Nothing Then
Explorer.SelectFolder archiveFolder
SendKeys "{LEFT}"
Else
MsgBox "Archive folder not found!", vbExclamation
End If
End Sub

Private Sub Items_ItemAdd(ByVal Item As Object)
On Error GoTo ErrorHandler
Dim destFolder As Outlook.folder
Dim myNamespace As Outlook.NameSpace
Set myNamespace = Application.GetNamespace("MAPI")
' Adjust the folder path if "Non_@mycompany is not directly under the mailbox root
Set destFolder = myNamespace.Folders("myalias@mycomapny.com").Folders("Archive").Folders("Non_UMD")
If TypeName(Item) = "MailItem" Then
Dim mail As Outlook.mailItem
Set mail = Item
' Move if the sender's email address does not contain "umassd"
If InStr(1, mail.SenderEmailAddress, "umassd", vbTextCompare) = 0 Then
mail.Move destFolder
End If
End If
Exit Sub

ErrorHandler:
MsgBox "An error has occurred: " & Err.Description
End Sub