Macro to Write Rules

[Stratuser]

My firm's server crashed and wiped out all my rules for moving e-mails to
designated folders. Writing all the rules all over again will take several
hours, and I'm thinking it would be faster to write some VBA code to do it.

What is the VBA code that creates a rule that moves any e-mail from any
sender at FIRM A to a folder called "FIRM A"? Also, what is the VBA code
that creates a rule for moving any e-mail that I send to FIRM A to the folder
called "FIRM A"?

Thanks for your help.

 

[Ken Slovak - [MVP - Outlook]]

Is this Outlook 2007? If not there is no VBA that creates a rule. You can do
what a rule does using pure code, but then you would handle the NewMailEx()
event or ItemAdd on the Inbox Items collection, and check each incoming item
for whatever conditions you want and take whatever actions you want entirely
in code.

The sent rule would require handling ItemAdd on the Items collection of the
Sent Items folder.

 

[Stratuser]

Unfortunately, I'm a newbie to Outlook VBA. What would be the code for
moving any e-mail to or from Firm_A to the folder named Firm_A (under the
Inbox)? If you can get me this far, I guess I can just alter the code.

 

[Ken Slovak - [MVP - Outlook]]

Something like this, placed in the ThisOutlookSession class module would
handle incoming emails, but you'd need to know to look in all those
subfolders of Inbox. It takes the part of the sender email address between
the "@" and the first "." as the company name:

Private Sub Application_NewMailEx(ByVal EntryIDCollection As String)
Dim oNS As Outlook.NameSpace
Dim oMail As Outlook.MailItem
Dim oMoved As Outlook.MailItem
Dim oTarget As Outlook.MAPIFolder
Dim oInbox As Outlook.MAPIFolder
Dim obj As Object

Dim sIDs() As String
Dim sRecip As String

Dim i As Long
Dim lPos As Long

sIDs = Split(EntryIDCollection, ",")

Set oNS = Application.GetNamespace("MAPI")
Set oInbox = oNS.GetDefaultFolder(olFolderInbox)

For i = LBound(sIDs) To UBound(sIDs)
Set obj = oNS.GetItemFromID(sIDs(i))
If obj.Class = olMail Then
Set oMail = obj
Set obj = Nothing

sRecip = oMail.SenderEmailAddress
lPos = InStr(1, sRecip, "@")
' strip out everything up to and including "@"
sRecip = Right(sRecip, Len(sRecip) - lPos)

lPos = InStr(1, sRecip, ".")
' strip everything from "." on
sRecip = Left(sRecip, lPos - 1)

Set oTarget = oInbox.Folders.Item(sRecip)
If oTarget Is Nothing Then
oInbox.Folders.Add (sRecip)
End If

Set oMoved = oMail.Move(oTarget)
End If
Next
End Sub

For the Sent Items folder handling you'd need something similar, in an
ItemAdd() event handler. You can find examples of ItemAdd() handlers at
www.outlookcode.com, one I can think of offhand for Inbox is "zaphtml", you
can search on that for an example.

 

[Stratuser]

Thanks very much. I pasted this code in, and then I got an internal e-mail.
Apparently the e-mail address for internal senders here is a long
unrecognizable string that starts with a "/". I wrote an "IF" statement to
screen out those e-mails, assuming that external e-mails don't have the same
pattern.

Your code seems to create a new folder for each new external e-mail sender.
I think I'll want to specify the folder names in advance, because there are
about 30 specific firms that will send me e-mails, and the list doesn't
change often.

Thanks for your help.