Creating Exchange 2000/2003 Mailbox Rules programmatically via Rule.DLL

[ncuxa.NET]

Hi there,
I've wrote a script, based on code found in this group, but I have a
question "How can I supress a window, that WSH gives me during logon
process into mailbox" (e.g. This happens if usernames looks like: john,
johnm, johni. As for me this window is a CDO window (same window that
Outlook shows when you try to resolve e-mail in GAL during mailbox
setup process))

Thanks.

--CUT--
' Mass Exchange Rule Inserter
' My VBS Skills are ugly, but :)
' 2006 Alexander Dondokov
Function FindStr(SearchString,SearchChar)
StrLengthSearchString = Len(SearchString)
StrLengthSearchChar = Len(SearchChar)
intPosition = Instr(1, SearchString, SearchChar, 1)
If intPosition >= 1 Then
FindStr = 1
Else
FindStr = 0
End If

If SearchString = "" Then
FindStr = 1
End If

End Function

Sub InsertJunkEmailRule(strDomainController, strMailAlias)
Const ACTION_MOVE = 1
Const CdoPR_TRANSPORT_MESSAGE_HEADERS = &H7D001E
Const IGNORECASE = &H10000
Set objRules = CreateObject("MSExchange.Rules")
Set objRule = CreateObject("MSExchange.Rule")
Set objPropVal = CreateObject("MSExchange.PropertyValue")
Set objAction = CreateObject("MSExchange.Action")
Set objContCond = CreateObject("MSExchange.ContentCondition")
Set objSession = CreateObject("MAPI.Session")
strJunkEmailFolderRUS = "Нежелательная почта"
strJunkEmailFolderENU = "Junk E-mail"
strSpamTag = "X-Spam-Flag: YES"
strSpamTagRule = "Move Messages with X-Spam-Flag: YES to Junk E-mail
Folder"
strProfile = strDomainController & vbLf & strMailAlias
strErrRuleExists = "Rule already exists"
strErrRuleCreated = "Rule created successfully"
objSession.Logon "",,, False,, True, strProfile
Set objInbox = objSession.Inbox
Set CdoInfoStore = objSession.GetInfoStore
Set CdoFolderRoot = CdoInfoStore.RootFolder
Set CdoFolders = CdoFolderRoot.Folders
bFound = False
bRuleExist = False

Set CdoFolder = CdoFolders.GetFirst
Do While (Not bFound) And Not (CdoFolder Is Nothing)
If CdoFolder.Name = strJunkEmailFolderRUS or CdoFolder.Name =
strJunkEmailFolderENU Then
bFound = True
Else
Set CdoFolder = CdoFolders.GetNext
End If
Loop
Set ActionFolder = CdoFolder

objRules.Folder = objInbox
For Each EnumRule In objRules
If EnumRule.Name = strSpamTagRule Then
Wscript.Echo(Date & vbTab & Time & vbTab & strDomainController &
vbTab & strMailAlias & vbTab & strErrRuleExists)
bRuleExist = True
End If
Next

If bRuleExist = False Then
objRules.Folder = objInbox
objPropVal.Tag = CdoPR_TRANSPORT_MESSAGE_HEADERS
objPropVal.Value = strSpamTag
objContCond.Value = objPropVal
objContCond.PropertyType = CdoPR_TRANSPORT_MESSAGE_HEADERS
objContCond.Operator = 1 + IGNORECASE
objAction.ActionType = ACTION_MOVE
objAction.Arg = ActionFolder
objRule.Name = strSpamTagRule
objRule.Condition = objContCond
objRule.Actions.Add ,objAction
objRules.add , objRule
objRules.update
Wscript.Echo(Date & vbTab & Time & vbTab & strDomainController &
vbTab & strMailAlias & vbTab & strErrRuleCreated)
End If

objSession.Logoff

End Sub

StrBase = "<LDAP://" & "CN=Microsoft
Exchange,CN=Services,CN=Configuration,DC=DOMAIN,DC=COM" & ">;"
strFilter =
"(&(ObjectClass=msExchPrivateMDB)(ObjectCategory=msExchPrivateMDB));"
strAttrs = "homeMDBBL;"
strScope = "subtree"

set objConn = CreateObject("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
Set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
objRS.MoveFirst
while Not objRS.EOF
For Each objItem in objRS.Fields(0).Value
Set objItemUser = GetObject("LDAP://" & objItem)
strDomainController = "localhost"
strMailAlias = objItemUser.MailNickName

If FindStr(strMailAlias,"SystemMailbox") = 1 or
FindStr(strMailAlias,"-SA") = 1 or FindStr(strMailAlias,Null) = 1 Then
WScript.Echo("System Mailbox Found: " & strMailAlias & "
skipping...")
Else
If objItemUser.msExchHideFromAddressLists = "True" or
objItemUser.userAccountControl = "514" Then
WScript.Echo("User Mailbox Found: " & strMailAlias & " User is
Hidden from GAL or Disabled...")
Else
WScript.Echo("User Mailbox Found: " & strMailAlias & "
inserting rule...")
InsertJunkEmailRule strDomainController, strMailAlias
End If
End If

Next
objRS.MoveNext
wend

' Performing Cleanup
Set objRules = Nothing
Set objRule = Nothing
Set objPropVal = Nothing
Set objAction = Nothing
Set objContCond = Nothing
Set objSession = Nothing
Set strSpamTag = Nothing
Set strSpamTagRule = Nothing
Set strDomainController = Nothing
Set strMailAlias = Nothing
Set strProfile = Nothing
Set strErrRuleExists = Nothing
Set strErrRuleCreated = Nothing
Set objInbox = Nothing
Set CdoInfoStore = Nothing
Set CdoFolderRoot = Nothing
Set CdoFolders = Nothing
Set bFound = Nothing
Set bRuleExist = Nothing
Set EnumRule = Nothing
Set strJunkEmailFolderENU = Nothing
Set strJunkEmailFolderRUS = Nothing

Set StrBase = Nothing
Set strFilter = Nothing
Set strAttrs = Nothing
Set strScope = Nothing
Set objConn = Nothing
Set objRS = Nothing
Set objItem = Nothing
Set objItemUser = Nothing
Set strDomainController = Nothing
Set strMailAlias = Nothing

Wscript.Quit
--CUT--

[ncuxa.NET]

I've wrote a new version of script, that creates rule "Move Messages
with X-Spam-Flag: YES to Junk E-mail Folder".

Just set "strExchangeOrgDN" variable to yours, and save code in Unicode
format.

<=CUT=>
'============================================================================================================
'
' NAME: UnicodeCDOSpamRuleHeadersAllMailboxesInExchangeOrganization.vbs
' VERSION: 1.03
' AUTHOR: Alexander Dondokov
' DATE : 02/08/2006
'
' USAGE:
' 1) CScript //NoLogo
UnicodeCDOSpamRuleHeadersAllMailboxesInExchangeOrganization.vbs
' 2) CScript //NoLogo
UnicodeCDOSpamRuleHeadersAllMailboxesInExchangeOrganization.vbs >
LogFile.tsv
'
' COMMENTS: This VBS script creates Exchange Server Rule in the users
mailboxes gathered from Active Directory
' This script contains code written by:
' Robbie Allen
' Glen Scales
' Microsofts Script Center and Scripting Guy.
'
'============================================================================================================

On Error Resume Next

strJunkEmailFolderRUS = "Нежелательная почта"
strJunkEmailFolderENU = "Junk E-mail"
strSpamTag = "X-Spam-Flag: YES"
strSpamTagRule = "Move Messages with X-Spam-Flag: YES to Junk E-mail
Folder"

strErrRuleExists = "Rule already exists"
strErrRuleCreated = "Rule created"

strErrRuleNotCreated = "Rule not created"
strErrUserDisabled = "User is Hidden from GAL or Disabled"
strErrSystemMailbox = "System, SMTP or System Attendant Mailbox"
strErrMAPI = "MAPI Error Code "
strExchangeOrgDN = "CN=Microsoft
Exchange,CN=Services,CN=Configuration,DC=MYDOMAIN,DC=COM"

strFilter =
"(&(ObjectClass=msExchPrivateMDB)(ObjectCategory=msExchPrivateMDB));"
strAttrs = "homeMDBBL;"
strScope = "subtree"

Function FindStr(SearchString,SearchChar)
StrLengthSearchString = Len(SearchString)
StrLengthSearchChar = Len(SearchChar)
intPosition = Instr(1, SearchString, SearchChar, 1)
If intPosition >= 1 Then
FindStr = 1
Else
FindStr = 0
End If

If SearchString = "" Then
FindStr = 1
End If

End Function

Sub InsertJunkEmailRule(strDomainController, strMailAlias,
strSAMAccountName, strDistinguishedName)

Const ACTION_MOVE = 1
Const CdoPR_TRANSPORT_MESSAGE_HEADERS = &H7D001E
Const IGNORECASE = &H10000
Set objRules = CreateObject("MSExchange.Rules")
Set objRule = CreateObject("MSExchange.Rule")
Set objPropVal = CreateObject("MSExchange.PropertyValue")
Set objAction = CreateObject("MSExchange.Action")
Set objContCond = CreateObject("MSExchange.ContentCondition")
Set objSession = CreateObject("MAPI.Session")

strProfile = strDomainController & vbLf & strMailAlias

WScript.StdOut.Write(Date & vbTab & Time & vbTab & strDomainController
& vbTab & strMailAlias & vbTab & strSAMAccountName & vbTab &
strDistinguishedName & vbTab)

objSession.Logon "",,, False,, True, strProfile
Set objInbox = objSession.Inbox
Set CdoInfoStore = objSession.GetInfoStore
Set CdoFolderRoot = CdoInfoStore.RootFolder
Set CdoFolders = CdoFolderRoot.Folders
bFound = False
bRuleExist = False

Set CdoFolder = CdoFolders.GetFirst
Do While (Not bFound) And Not (CdoFolder Is Nothing)
If CdoFolder.Name = strJunkEmailFolderRUS or CdoFolder.Name =
strJunkEmailFolderENU Then
bFound = True
Else
Set CdoFolder = CdoFolders.GetNext
End If
Loop
Set ActionFolder = CdoFolder

objRules.Folder = objInbox
For Each EnumRule In objRules
If EnumRule.Name = strSpamTagRule Then

Wscript.Echo(strErrRuleNotCreated & vbTab & strErrRuleExists)

bRuleExist = True
End If
Next

If bRuleExist = False Then
' objRules.Folder = objInbox
' objPropVal.Tag = CdoPR_TRANSPORT_MESSAGE_HEADERS
' objPropVal.Value = strSpamTag
' objContCond.Value = objPropVal
' objContCond.PropertyType = CdoPR_TRANSPORT_MESSAGE_HEADERS
' objContCond.Operator = 1 + IGNORECASE
' objAction.ActionType = ACTION_MOVE
' objAction.Arg = ActionFolder
' objRule.Name = strSpamTagRule
' objRule.Condition = objContCond
' objRule.Actions.Add ,objAction
' objRules.add , objRule
' objRules.update

WScript.StdOut.Write(strErrRuleCreated & vbTab)
End If

objSession.Logoff

End Sub

Wscript.Echo("Date" & vbTab & "Time" & vbTab & "Domain Controller" &
vbTab & "Display Name" & vbTab & "SAM Account Name" & vbTab &
"Distinguished Name" & vbTab & "Result" & vbTab & "Error" & vbTab &
"Error Details")

StrBase = "<LDAP://" & strExchangeOrgDN & ">;"

set objConn = CreateObject("ADODB.Connection")
objConn.Provider = "ADsDSOObject"
objConn.Open "Active Directory Provider"
Set objRS = objConn.Execute(strBase & strFilter & strAttrs & strScope)
objRS.MoveFirst
while Not objRS.EOF
For Each objItem in objRS.Fields(0).Value
Set objItemUser = GetObject("LDAP://" & objItem)
strDomainController = "localhost"

strMailAlias = objItemUser.DisplayName
strMailNickName = objItemUser.MailNickName
strSAMAccountName = objItemUser.SAMAccountName
strDistinguishedName = objItemUser.DistinguishedName
'MailNickName

If FindStr(strMailAlias,"SystemMailbox") = 1 or

FindStr(strMailAlias,Null) = 1 Then

Wscript.Echo(Date & vbTab & Time & vbTab & strDomainController

& vbTab & strMailAlias & vbTab & strSAMAccountName & vbTab &
strDistinguishedName & vbTab & strErrRuleNotCreated & vbTab &
strErrSystemMailbox)

Else
If objItemUser.msExchHideFromAddressLists = "True" or
objItemUser.userAccountControl = "514" Then

Wscript.Echo(Date & vbTab & Time & vbTab & strDomainController

& vbTab & strMailAlias & vbTab & strSAMAccountName & vbTab &
strDistinguishedName & vbTab & strErrRuleNotCreated & vbTab &
strErrUserDisabled)
Else
InsertJunkEmailRule strDomainController, strMailAlias,
strSAMAccountName, strDistinguishedName
'WScript.Echo(strErrMAPI & CStr(Err.Number) & vbTab &
Err.Description)
'Err.Clear
If CStr(Err.Number) <> "0" Then
WScript.Echo(strErrRuleNotCreated & vbTab & strErrMAPI &
CStr(Err.Number) & vbTab & Err.Description)
Err.Clear
Else
WScript.Echo(strErrMAPI & CStr(Err.Number) & vbTab &
Err.Description)
Err.Clear
End If

End If
End If

Next
objRS.MoveNext
wend

Set objRules = Nothing

Set strErrMAPI = Nothing
Set strExchangeOrgDN = Nothing

Wscript.Quit

<=CUT=>

P.S. My question about CDO window, that contains promt to choose user
account is still open, can somebody help me with this ???
Thnaks.

[Glen Scales [MVP]]

You usually get this popup when your not using the right mailbox alias eg if
you are using the logonname and the logonname and the mailbox alias are
different (in the case someone has renamed the account or for some other
reason). You can easliy get rid of the dialouge by setting the showDialog
parameter in the Logon method to false (this is the 3rd parameter in the
method) at the moment in your code this blank and the default is true. eg I
would use

objSession.Logon "","",false,false,,true,strProfile

Once you get rid of the dialouge you may find this is replaced with a
MAPI_E_LOGON_FAILED(80040111) error if the alias is not correct so you might
want to consider using mailNickname Ad property as the alias in your script.
(there's a good referance for the logon method
http://www.vbip.com/books/1861002068/chapter_2068_04.asp )

Cheers
Glen

"ncuxa.NET" <Alexander...@gmail.com> wrote in message
news:1154523208.4...@i3g2000cwc.googlegroups.com...

I've wrote a new version of script, that creates rule "Move Messages
with X-Spam-Flag: YES to Junk E-mail Folder".

Just set "strExchangeOrgDN" variable to yours, and save code in Unicode
format.

<=CUT=>
'============================================================================================================
'
' NAME: UnicodeCDOSpamRuleHeadersAllMailboxesInExchangeOrganization.vbs
' VERSION: 1.03
' AUTHOR: Alexander Dondokov
' DATE : 02/08/2006
'
' USAGE:
' 1) CScript //NoLogo
UnicodeCDOSpamRuleHeadersAllMailboxesInExchangeOrganization.vbs
' 2) CScript //NoLogo
UnicodeCDOSpamRuleHeadersAllMailboxesInExchangeOrganization.vbs >
LogFile.tsv
'
' COMMENTS: This VBS script creates Exchange Server Rule in the users
mailboxes gathered from Active Directory
' This script contains code written by:
' Robbie Allen
' Glen Scales
' Microsofts Script Center and Scripting Guy.
'
'============================================================================================================

On Error Resume Next

strJunkEmailFolderRUS = "????????????? ?????"

[ncuxa.NET]

Thanks, Glen.
I've tried to use strMailNickName, e.g.:
InsertJunkEmailRule strDomainController, strMailNickName,
strSAMAccountName, strDistinguishedName
And set ShowDialog to False, e.g.:
objSession.Logon "","",False,False,,True,strProfile
But, when I started to analyze the output, generated by script, I got
more "The information store could not be opened. [MAPI 1.0 -
[MAPI_E_LOGON_FAILED(80040111)]]" errors, because MailNickName
attributes for few users are almost equal, e.g.:
User1: Ivan Ivanov; mailnNickName: Ivanov
User2: Peter Ivanov; mailnNickName: IvanovP
User4: Nataly Ivanova; mailnNickName: Ivanova

Variant 1: When script tries to resolve User1 (and ShowDialog set to
True in objSession.Logon), popup window appears with three users
resolved in GAL, and you must manually choose the right user account.

Variant 2: When script tries to resolve User1 (and ShowDialog set to
False in objSession.Logon), popup window doesn't appear with three
users resolved in GAL, and we've got error 80040111, because no one is
choosen.

As I understood, I have to change mailNickName attribute to be unique?

P.S. When I'm using DisplayName attribute in strProfile, i got less
errors 80040111, because users names are different.

[Glen Scales [MVP]]

Okay I see your problem what about using the email address this shouldn't be
ambiguous and it should work simular to the other attributes.

Cheers
Glen

"ncuxa.NET" <Alexander...@gmail.com> wrote in message

news:1154685099.8...@h48g2000cwc.googlegroups.com...

[ncuxa.NET]

Thank You VERY MUCH !!!
I've changed strMailAlias = objItemUser.DisplayName -> strMailAlias =
objItemUser.Mail, and it works great.
No more "[MAPI 1.0 - [MAPI_E_LOGON_FAILED(80040111)]]" Errors :)