-
Promt Warning List External Users, on VB Script to checks for external users
Hello All,
i have the following VB Script,
It checks for external users and promts for a confirmation if it detects any email that is not listed on the domains,
Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objMail As Outlook.MailItem
Dim objRecipients As Outlook.Recipients
Dim i As Long
Dim strRecipientAddress As String
Dim strPrompt As String
Dim nWarning As Integer
If TypeOf Item Is MailItem Then
Set objMail = Item
Set objRecipients = objMail.Recipients
For i = objRecipients.Count To 1 Step -1
strRecipientAddress = objRecipients.Item(i).Address
'Change @example.com to your own company domain
If InStr(LCase(strRecipientAddress), "@my1Domain.com") <= 0 Then
If InStr(LCase(strRecipientAddress), "@my2Domain.com") <= 0 Then
If InStr(LCase(strRecipientAddress), "@my3Domain.com") <= 0 Then
If InStr(LCase(strRecipientAddress), "@my4Domain.com") <= 0 Then
If InStr(LCase(strRecipientAddress), "@my5Domain.com") <= 0 Then
Else
Cancel = False
End If
End If
End If
End If
End If
Next
strPrompt = "Are you sure to send this email to outside your company? "
nWarning = MsgBox(strPrompt, vbYesNo + vbQuestion, "Confirm Email to Outside Organization")
If nWarning = vbNo Then
Cancel = True
End If
End If
End Sub
Actually in this way everything works just fine,
but i would like to modify the Promt, i would like to list all the external users on the Promt of the confirmation.,
is this possible to be integrated on this script?
Please note that i found a lot of bugs on using the following,
Code:
Const PR_SMTP_ADDRESS As String = "http://schemas.microsoft.com/mapi/proptag/0x39FE001E"
So what i'm looking for is an alternative of this.
Thank you in advance for the support.
-
Re: Promt Warning List External Users, on VB Script to checks for external users
you should use a select case inplace of all the if statements
try like
Code:
For i = 1 To objRecipients.Count ' no need to step backwards as you are not removing items from the collection
strRecipientAddress = objRecipients.Item(i).Address
domain = Mid(strRecipientAddress, InStr(s, "@"))
Select Case domain
Case "@my1Domain.com", "@my2Domain.com", "@my3Domain.com", "@my4Domain.com", "@my5Domain.com"
Case Else: rejects = rejects & vbNewLine & strRecipientAddress
End Select
Next
any one not in the listed domains will be added to the reject list, then include the reject list in your prompt
if the reject list is empty then all recipients are within the company domains and no need for prompt
-
Re: Promt Warning List External Users, on VB Script to checks for external users
Hello westconn1,
thanks for the suggestion,
following the code on your suggestion is failing and the debug stops on
Code:
domain = Mid(strRecipientAddress, InStr(s, "@"))
Any suggestions?
Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objMail As Outlook.MailItem
Dim objRecipients As Outlook.Recipients
Dim i As Long
Dim strRecipientAddress As String
Dim strPrompt As String
If TypeOf Item Is MailItem Then
Set objMail = Item
Set objRecipients = objMail.Recipients
For i = 1 To objRecipients.Count ' no need to step backwards as you are not removing items from the collection
strRecipientAddress = objRecipients.Item(i).Address
domain = Mid(strRecipientAddress, InStr(s, "@"))
Select Case domain
Case "@my1domain.com", "@my2domain.com", "@my3domain.com", "@my4domain.com", "@my5domain.com"
Case Else: rejects = rejects & vbNewLine & strRecipientAddress
End Select
Next
If rejects <> "" Then
strPrompt = "This email will be sent outside of the company to:" & vbNewLine & strRecipientAddress & vbNewLine & "Please check recipient address." & vbNewLine & vbNewLine & "Do you still wish to send?"
If MsgBox(strPrompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
End If
End If
End If
End Sub
Thanks in advance.
-
Re: Promt Warning List External Users, on VB Script to checks for external users
did you define the varaible?
as you did not specify what error this is just a guess
-
Re: Promt Warning List External Users, on VB Script to checks for external users
You have an InStr(s,"@")
What is "s"?
EDIT:
btw: If you just want to grab the domain of an EMail-Address....
Code:
Dim sAddress As String
Dim arrTemp() As String
Dim sDomain As String
sAddress = "[email protected]"
If InStrRev(sAddress, "@") Then
arrTemp = Split(sAddress, "@")
sDomain = arrTemp(UBound(arrTemp))
End If
or shorter
Code:
Dim sAddress As String
Dim sDomain As String
sAddress = "[email protected]"
If InStrRev(sAddress, "@") Then
sDomain = Split(sAddress, "@")(1)
End If
Of course, that way you have to change your Select Case to check without the @-sign (or you prepend the @-sign to the result(s))
-
Re: Promt Warning List External Users, on VB Script to checks for external users
That was the suggested sollution by westconn1,
Following the full code.
Probably i missed something, could you please update it in case i missed any variable here?
Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objMail As Outlook.MailItem
Dim objRecipients As Outlook.Recipients
Dim i As Long
Dim strRecipientAddress As String
Dim strPrompt As String
If TypeOf Item Is MailItem Then
Set objMail = Item
Set objRecipients = objMail.Recipients
For i = 1 To objRecipients.Count ' no need to step backwards as you are not removing items from the collection
strRecipientAddress = objRecipients.Item(i).Address
domain = Mid(strRecipientAddress, InStr(s, "@"))
Select Case domain
Case "@my1domain.com", "@my2domain.com", "@my3domain.com", "@my4domain.com", "@my5domain.com"
Case Else: rejects = rejects & vbNewLine & strRecipientAddress
End Select
Next
If rejects <> "" Then
strPrompt = "This email will be sent outside of the company to:" & vbNewLine & strRecipientAddress & vbNewLine & "Please check recipient address." & vbNewLine & vbNewLine & "Do you still wish to send?"
If MsgBox(strPrompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
End If
End If
End If
End Sub
-
Re: Promt Warning List External Users, on VB Script to checks for external users
Quote:
Originally Posted by
charli1
That was the suggested sollution by westconn1,
Following the full code.
Probably i missed something, could you please update it in case i missed any variable here?
vb Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objMail As Outlook.MailItem
Dim objRecipients As Outlook.Recipients
Dim i As Long
Dim strRecipientAddress As String
Dim strPrompt As String
If TypeOf Item Is MailItem Then
Set objMail = Item
Set objRecipients = objMail.Recipients
For i = 1 To objRecipients.Count ' no need to step backwards as you are not removing items from the collection
strRecipientAddress = objRecipients.Item(i).Address
domain = Mid(strRecipientAddress, InStr(s, "@"))
Select Case domain
Case "@my1domain.com", "@my2domain.com", "@my3domain.com", "@my4domain.com", "@my5domain.com"
Case Else: rejects = rejects & vbNewLine & strRecipientAddress
End Select
Next
If rejects <> "" Then
strPrompt = "This email will be sent outside of the company to:" & vbNewLine & strRecipientAddress & vbNewLine & "Please check recipient address." & vbNewLine & vbNewLine & "Do you still wish to send?"
If MsgBox(strPrompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
End If
End If
End If
End Sub
Your Problem is in Line 14 the InStr(s, "@")
you don't assign a value to "s"
at a guess: that "s" should be strRecipientAddress
-
Re: Promt Warning List External Users, on VB Script to checks for external users
OK so it should be
or
Thank you.
-
Re: Promt Warning List External Users, on VB Script to checks for external users
OK, so it should be?
or
Thank you.
-
Re: Promt Warning List External Users, on VB Script to checks for external users
Neither!
Code:
Dim sAddress As String
Dim sDomain As String
sAddress = "[email protected]"
sDomain = Mid(sAddress, InStr(sAddress, "@"))
Code:
domain = Mid(strRecipientAddress, InStr(strRecipientAddress, "@"))
-
Re: Promt Warning List External Users, on VB Script to checks for external users
sorry i posted in a rush before work, thought i had fixed all my temps
should have been, as pointed out by zvoni
Code:
For i = 1 To objRecipients.Count ' no need to step backwards as you are not removing items from the collection
strRecipientAddress = objRecipients.Item(i).Address
domain = Mid(strRecipientAddress, InStr(strRecipientAddress, "@"))
Select Case domain
Case "@my1Domain.com", "@my2Domain.com", "@my3Domain.com", "@my4Domain.com", "@my5Domain.com"
Case Else: rejects = rejects & vbNewLine & strRecipientAddress
End Select
Next
no need for s variable at all, i just used it to test i got the correct results before posting, i changed it in some places, but missed the one
-
Re: Promt Warning List External Users, on VB Script to checks for external users
Pete,
btw: I'd rather use InStrRev instead of InStr in your solution.
Just in case some jokster thinks an Address like "MyName@[email protected]" is funny.....
But i admit: It's been a long time since i've read the RFC for valid E-Mail-Addresses
-
Re: Promt Warning List External Users, on VB Script to checks for external users
Hi
I use this for saving attachments from particular Email-addresses in the Inbox
it checks the SenderName with Like
Code:
Public Function SaveAttachments()
Dim myFolderName As String
Dim objPosteingang As MAPIFolder
Dim objNewMail As MailItem
Dim Anzahl As Long
Dim i As Long
On Error Resume Next
Set objPosteingang = Application.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox)
For Each objNewMail In objPosteingang.Items
With objNewMail
'only Save Attachments if Post is New
If .UnRead = True Then
'get only Attachments from :
If .SenderName Like "[email protected]" Or _
.SenderName Like "[email protected]" Then
Anzahl = .Attachments.Count
If Anzahl > 0 Then
'create the Folder to save to:
myFolderName = "C:\Labor\" & objNewMail.SenderName & Space(4) & objNewMail.ConversationTopic
MkDir myFolderName
For i = 1 To Anzahl
.Attachments.Item(i).SaveAsFile myFolderName & "\" & .Attachments.Item(i).FileName
Next i
End If
End If
End If
End With
Next objNewMail
Set objPosteingang = Nothing
Set objNewMail = Nothing
End Function
regards
Chris
-
Re: Promt Warning List External Users, on VB Script to checks for external users
Still stuck at this line,
Code:
domain = Mid(strRecipientAddress, InStr(strRecipientAddress, "@"))
following the full code.
Code:
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
Dim objMail As Outlook.MailItem
Dim objRecipients As Outlook.Recipients
Dim i As Long
Dim strRecipientAddress As String
Dim strPrompt As String
Dim Address As String
Dim domain As String
If TypeOf Item Is MailItem Then
Set objMail = Item
Set objRecipients = objMail.Recipients
For i = 1 To objRecipients.Count ' no need to step backwards as you are not removing items from the collection
strRecipientAddress = objRecipients.Item(i).Address
domain = Mid(strRecipientAddress, InStr(strRecipientAddress, "@"))
Select Case domain
Case "@my1Domain.com", "@my2Domain.com", "@my3Domain.com", "@my4Domain.com", "@my4Domain.com"
Case Else: rejects = rejects & vbNewLine & strRecipientAddress
End Select
Next
If rejects <> "" Then
strPrompt = "This email will be sent outside of the company to:" & vbNewLine & strRecipientAddress & vbNewLine & "Please check recipient address." & vbNewLine & vbNewLine & "Do you still wish to send?"
If MsgBox(strPrompt, vbYesNo + vbExclamation + vbMsgBoxSetForeground, "Check Address") = vbNo Then
Cancel = True
End If
End If
End If
End Sub
-
Re: Promt Warning List External Users, on VB Script to checks for external users
Quote:
Still stuck at this line,
you still did not post what the error is
see post #4 first line
-
Re: Promt Warning List External Users, on VB Script to checks for external users
Quote:
Originally Posted by
westconn1
you still did not post what the error is
see post #4 first line
Hi westconn1,
sorry about that,
The error im facing is in italian language,
http://i67.tinypic.com/1z39ykw.png
And if i click on debug, the pop window VB editor on the line
http://i65.tinypic.com/iyonja.png
-
Re: Promt Warning List External Users, on VB Script to checks for external users
Runtime-Error 5 translates to "Invalid Procedure-Call" (or similiar - i have german VBA)
What's the Value of strRecipientAddress?
What's the Return-Value of the InStr-Call?
The only reason i know why Mid should fail is if InStr returns 0
-
Re: Promt Warning List External Users, on VB Script to checks for external users
Hello Zvoni,
well the value of the
Code:
strRecipientAddress
is 0, but why it is 0 i dont know, i have multiple external domain emails on my test.
but if i change the in or the script works fine.
Any clue on this?
-
Re: Promt Warning List External Users, on VB Script to checks for external users
Look at my Post #7:
Insert between Line 13 and 14 a "Debug.Print strRecipientAddress".
What's the value?
If it's empty then there is something wrong with your Collection
-
Re: Promt Warning List External Users, on VB Script to checks for external users
It doesn't print nothing.
-
Re: Promt Warning List External Users, on VB Script to checks for external users
Found the issue,
the actual script cannot extract the email address of the EX email formats,
i just tested excluding the exchange email, and inserting recipients in SMTP mail formats the script works fine.
How can i fix this to correctly extract the EX email formats?
-
Re: Promt Warning List External Users, on VB Script to checks for external users
i do not have access to an exchange server account, but there are many examples in a google search
i found https://answers.microsoft.com/en-us/...b81c9ecd1?db=5 which has a function that should be able to do what you want