-
Sep 23rd, 2018, 09:30 AM
#1
Thread Starter
New Member
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.
Last edited by charli1; Sep 23rd, 2018 at 09:38 AM.
-
Sep 23rd, 2018, 04:30 PM
#2
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
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Sep 23rd, 2018, 07:14 PM
#3
Thread Starter
New Member
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.
Last edited by charli1; Sep 23rd, 2018 at 07:42 PM.
-
Sep 24th, 2018, 03:14 AM
#4
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
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Sep 24th, 2018, 03:36 AM
#5
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 = "test@domain.com"
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 = "test@domain.com"
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))
Last edited by Zvoni; Sep 24th, 2018 at 03:47 AM.
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
Sep 24th, 2018, 03:42 AM
#6
Thread Starter
New Member
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
-
Sep 24th, 2018, 03:51 AM
#7
Re: Promt Warning List External Users, on VB Script to checks for external users
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
Last edited by Zvoni; Sep 24th, 2018 at 03:54 AM.
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
Sep 24th, 2018, 03:55 AM
#8
Thread Starter
New Member
Re: Promt Warning List External Users, on VB Script to checks for external users
OK so it should be
or
Thank you.
-
Sep 24th, 2018, 03:56 AM
#9
Thread Starter
New Member
Re: Promt Warning List External Users, on VB Script to checks for external users
OK, so it should be?
or
Thank you.
-
Sep 24th, 2018, 04:04 AM
#10
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 = "test@domain.com"
sDomain = Mid(sAddress, InStr(sAddress, "@"))
Code:
domain = Mid(strRecipientAddress, InStr(strRecipientAddress, "@"))
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
Sep 24th, 2018, 04:14 AM
#11
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
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Sep 24th, 2018, 04:18 AM
#12
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@MyFamily@MyDomain.com" is funny.....
But i admit: It's been a long time since i've read the RFC for valid E-Mail-Addresses
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
Sep 24th, 2018, 04:48 AM
#13
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 "abc@t-online.de" Or _
.SenderName Like "xyz@t-online.de" 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
to hunt a species to extinction is not logical !
since 2010 the number of Tigers are rising again in 2016 - 3900 were counted. with Baby Callas it's 3901, my wife and I had 2-3 months the privilege of raising a Baby Tiger.
-
Sep 24th, 2018, 06:05 AM
#14
Thread Starter
New Member
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
-
Sep 24th, 2018, 06:39 AM
#15
Re: Promt Warning List External Users, on VB Script to checks for external users
Still stuck at this line,
you still did not post what the error is
see post #4 first line
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
-
Sep 24th, 2018, 07:26 AM
#16
Thread Starter
New Member
Re: Promt Warning List External Users, on VB Script to checks for external users
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,
And if i click on debug, the pop window VB editor on the line
-
Sep 24th, 2018, 08:35 AM
#17
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
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
Sep 24th, 2018, 08:43 AM
#18
Thread Starter
New Member
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?
-
Sep 24th, 2018, 09:03 AM
#19
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
Last edited by Zvoni; Tomorrow at 31:69 PM.
----------------------------------------------------------------------------------------
One System to rule them all, One Code to find them,
One IDE to bring them all, and to the Framework bind them,
in the Land of Redmond, where the Windows lie
---------------------------------------------------------------------------------
People call me crazy because i'm jumping out of perfectly fine airplanes.
---------------------------------------------------------------------------------
Code is like a joke: If you have to explain it, it's bad
-
Sep 24th, 2018, 09:14 AM
#20
Thread Starter
New Member
Re: Promt Warning List External Users, on VB Script to checks for external users
It doesn't print nothing.
-
Sep 24th, 2018, 09:22 AM
#21
Thread Starter
New Member
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?
-
Sep 24th, 2018, 04:11 PM
#22
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
i do my best to test code works before i post it, but sometimes am unable to do so for some reason, and usually say so if this is the case.
Note code snippets posted are just that and do not include error handling that is required in real world applications, but avoid On Error Resume Next
dim all variables as required as often i have done so elsewhere in my code but only posted the relevant part
come back and mark your original post as resolved if your problem is fixed
pete
Tags for this Thread
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|