I found a macro online that works mostly, but has glitch. When an email comes in from someone using a different domain name, the macro either creates a new folder if there is not a current folder with the domain name, or files that message in an existing folder with the domain name. The issue is that new folders are being created for messages coming in with the domain name, and I'm not too familiar with MS Outlook macros to know what to do. Any help would be appreciated!
Code:
Public Sub SortByDomain(oMsg As MailItem)
On Error Resume Next
Dim sDomain As String 'The Sender's domain
Dim oNS As Outlook.NameSpace 'My namespace
Dim oInbox As Outlook.MAPIFolder 'My Inbox
Dim oTarget As Outlook.MAPIFolder 'The domain folder
'If it's not your domain, decipher the domain.
If InStr(oMsg.SenderEmailAddress, "@mydomain.com") < 1 Then
sDomain = Mid(oMsg.SenderEmailAddress, InStr(oMsg.SenderEmailAddress, "@") + 1)
Else
sDomain = "mydomain.com"
End If
'Get the inbox.
Set oNS = Application.GetNamespace("MAPI")
Set oInbox = oNS.GetDefaultFolder(olFolderInbox)
'Set the domain folder if it exists.
Set oTarget = oInbox.Folders(sDomain)
'In case the folder doesn't exist...
If oTarget Is Nothing Then
oInbox.Folders.Add (sDomain)
Set oTarget = oInbox.Folders(sDomain)
End If
'Move the new mail to the folder.
oMsg.Move oTarget
'Cleanup.
Set oTarget = Nothing
Set oInbox = Nothing
Set oNS = Nothing
End Sub