Can I restrict email sent in Outlook without using Exchange?

[answrtek]

We are a very small company, using Outlook v.2000 through a web hosting
solution for our email. Email is setup to send and receive perfectly. We do
not have or even know how to use Exchange, and cannot afford it at any rate.
We have 10 or so computers, each with a stand alone version of Outlook v.2000
installed and users have a single email address to send / receive email from.
All computers are Win xp, fully patched.

For security and productivity purposes we want to limit the ability of a user
to send an email from Outlook (with or without attachments) to only those
email addresses that are listed in the contacts folder or ,alternatively we
would like to be able to specify a single domain name that you can send to
and restrict all others. Either approach would work for our purposes, however
the single domain approach would be best. (like @thisdomain.com) for some
users and the contacts better for others (based on position)

I've been able to accomplish a lot of things with Visual basic like this in
the past with almost every other Office application, (Access, Word, Excel,
PowerPoint) yet cannot seem to wrap my mind around how to accomplish this in
Outlook.

Every idea I've tried fails or just doesn't run, even if it compiles ok.
Rules don't seem to have this option and I haven't seen any 3rd party
affordable or even free software that can accomplish this. The only solutions
I seen are for Exchange administrators, and Like I said we do not have or use
Exchange.

To me, using VB Code it seems like I should be able to:

intercept the send command (i.e.- on the send button clicked etc)

compare the TO (and CC and BCC) recipient value in the email to the various
email addresses in the contacts folder (email1Address, email2Address, etc),
looping through all the contacts

and

allow it and send it if it matches (maybe even give a msgbox "Email matched,
send OK)

or

Disallow it if it doesn't (msg box "Sorry this message....etc) vbOkOnly etc
and not let it complete the send command

I'm at a loss. Can anybody help me with the VB code necessary to handle this
kind of event in Outlook? I've been googling and reading online posts for
three days and haven't seen anything that addresses this kind of need.

Seems simple, yet it is driving me a little goofy.

Thankx in advance,

 

[Ken Slovak - [MVP - Outlook]]

You can intercept the item.Send event and cancel it if desired. You can
search all contacts for matches to the recipients. In short, you can do
everything you desire to do.

Where is this code running? Is it in Outlook macros or in a COM addin? A COM
addin is best for robust deployment. Is this Outlook VBA code or VB.NET or
VB6 code?

 

[answrtek]

Thankx for answering. I appreciate how quickly you responded.

My problem is more with the syntax and the events in outlook and how to make
vb code work within outlook. The basic elements seem to be about the same,
however the way vb interacts with the application (properties, events,
procedures) is different enough to be confusing for a novice code writer like
myself.

I wanted to put it in vb code, using the Visual Basic Editor , attached to
ThisOutLookSession. If it were any other Office application I would say it is
in Macros, contained in a project module (in vbaProject.OTM).

Actually I'm not sure if this is vb6 or vba, but I think it is vba. However
in answer to your question, my code doesn't run. Thats the problem. I'm not
sure I even know how to start this so I can loop through the items correctly.
Easy enough to do in Access, but doesn't seem to be the same in Outlook to
me. I guess I do not understand enough about the OOM in order to be able to
develop code against it at this point.

Like I said, what I would like to do is figure out how to intercept the
"send" event, loop through all the email addresses contained in the contacts
folder and only allow those emails which have a match to be sent. I'd also
like to be able to intercept the "send" event, compare the domain(s) (like
".mydomain.com") and if it were going outside the allowed domain(s), disallow
it.

Can you help?

 

[Ken Slovak - [MVP - Outlook]]

What you are planning then is using VBA code in the Outlook VBA project.
Take a look at what Alan Moseley posted, it answers what you are asking for.

If you have any questions just post back in this group.

 

[answrtek]

I've tried modifying the code you supplied to me (or Alan did, not sure
which) and I thank you for that. I'm getting closer but still stuck at one
thing. How do you properly reference the email address on an email ? Here is
a sample of what I am trying to do, (keep in mind I know this code doesn't
work and doesn't accomplish anything), yet. I also know that this is pretty
much nonsense, because it looks like nonsense to me and has almost none of
ther affect I'm looking for. The TypeName statement just equals the subject
line of the email. I suppose the reason it is there is to get at the email in
the first place. I cant for the life of me figure out how to write a proper
DIM and SET statement that gets to that part of the email.

What I am trying to do is compare the email address or name they have used
in the TO box of an email they are creating and then sending to their
existing contacts email address in the contacts folder and if it does not
exist, not allow the email to be sent. No Match ? No Send.

Can anybody give me some thorough guidance on how to proceed?




Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim mi As MailItem
Dim cf As MAPIFolder
Dim rc As Items
Dim ct As ContactItem
Dim ob As AddressEntries

Set cf = Outlook.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
Set rc = cf.Items

If TypeName(Item) = "MailItem" Then

For Each ob In rc.Recipients

Select Case TypeName(ob)
Case "AddressBlank"
Set ct = ob
If ((ct.Email1Address = "") Or (ob.Email2Address = "") Or
(ob.Email3Address = "")) Then
MsgBox "No email address match in Contacts"

End If

Case "ContactAddress"
Set ct = ob
If ((ct.Email1Address = mi.Recipients) Or
(ct.Email2Address = mi.Recipients) Or (ct.Email3Address = mi.Recipients)) Then
MsgBox "Email allowed, matches approved Contact"

End If

Case "ContactName"
Set ct = ob
If ((ct = mi.Recipients)) Then
MsgBox "Message Sent, Email allowed, matches approved
Contact"

End If
Exit Sub

'Case "DistributionList"
'You might want to consider this possibility!
End Select
Next
End If

 

[Ken Slovak - [MVP - Outlook]]

That was code that was supplied by Alan.

I'd write that somewhat differently, here's how that would look:

Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim mi As MailItem
Dim cf As MAPIFolder
Dim rc As Items
Dim ct As ContactItem
Dim recip As Recipient
Dim obj As Object

Dim okToSend As Boolean
Dim strNoGood As String

If Item.Class = olMail Then
Set cf =
Application.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
Set rc = cf.Items

strNoGood = ""

Set mi = Item

For Each recip In mi.Recipients
okToSend = False

For Each obj In rc
If obj.Class = olContact Then
Set ct = obj
If ((ct.Email1Address = recip.Address) Or
(ob.Email2Address = recip.Address) _
Or (ob.Email3Address = recip.Address)) Then

okToSend = True

Exit For

End If
End If
Next

If okToSend = False Then
strNoGood = strNoGood & vbCRLF & recip.Name & " is not in
your Contacts folder"
End If
Next
End If

If strNoGood <> "" Then
Cancel = True

MsgBox strNoGood
End If

End Sub

 

[answrtek]

That does it. Perfect. I tweaked the following to match and it did exactly
what I was trying to do.

If ((ct.Email1Address = recip.Address) Or

(ob.Email2Address = recip.Address) _
Or (ob.Email3Address = recip.Address)) Then

Another headache put to bed. Thank you for your help.

answrtek