Since Exchange doesn’t use the mail attribute, you can’t use the Set-Mailbox attribute, especially if the mailbox is deleted anyway. I tried using Set-User with the -WindowsEmailAddress parameter, but because the data type is Microsoft.Exchange.Data.SmtpAddress, setting the value to "" or $null doesn’t work because those aren’t properly formatted SMTP addresses.

So, I figured I needed to get away from any Exchange cmdlet. I used PowerShell’s native support for ADSI to bind to the user object: New-Object DirectoryServices.DirectoryEntry "LDAP://UserDN". But you will get an error if you try to set the attribute to null ($user.mail = $null). You can set it to an empty value (""), but you will then get an error when you try to commit the change: $user.SetInfo().

How can you possibly clear this attribute, one that is so easy to do in ADUC just by deleting the value in it? It is necessary to fall back to the PutEx method. Using that will let you use the ADS_PROPERTY_CLEAR constant (indicated by the numeric one in the first argument). It has taken me days to finally get to this point, so hopefully this post will shorten that time for others trying to do the same thing.

$user = Get-User "username"
$ldapDN = "LDAP://" + $user.distinguishedName
$adUser = New-Object DirectoryServices.DirectoryEntry $ldapDN
$adUser.PutEx(1, "mail", $null)
$adUser.SetInfo()

So I decided to add what was going to be my fallback option in the first place: using a cached list. This code uses an xml file to keep track of the database to use at a given location and a timestamp of when that entry was last updated. The xml file uses the following format:

<?xml version="1.0"?>
<sites>
	<site id="Name1">
		<database name="Server1\Storage Group 1\Mailbox Store 1" />
		<timestamp time="2009-09-22T08:59:29.4878574-07:00" />
	</site>
	<site id="Name2">
		<database name="Server2\Storage Group 5\Mailbox Store 1" />
		<timestamp time="2009-09-22T08:17:51.5632031-07:00" />
	</site>
....
</sites>

Set the $sourcexml variable to the full path to the file. The function that calls this code should set the $Location parameter to whatever value is stored in the id attribute of the site nodes. The xml file is opened, the timestamp for a given site name is returned, and compared to a time interval (in this case, 24 hours, but you can set it to anything you want). If less than 24 hours old, the database name in the site node is used. If more than 24 hours old, it will run the code to determine the database to use (from the other post). After the determination is made, it writes the database name and the current time back into the xml file and saves it.

The on-demand query for one site ran in 53 seconds through mailbox creation for the first run, but created the second mailbox in 11 seconds. That is much more tenable, at least for an impatient person like myself.

$start = Get-Date
$sourcexml = "Path to input xml file.xml"
[xml]$db = Get-Content $sourcexml
$site = $db.sites.site | where {$_.id -eq $Location}
[datetime]$lastUpdate = $site.Timestamp.Time
if (($start - $lastUpdate).TotalHours -lt 24)
	{
	Write-Host "Timstamp for selected site is less than 24 hours old.  Using cached entry."
	$site.database.name
	}
else
	{
	Write-Host "Timestamp for selected site is more than 24 hours old.  Calculating database to use."
	#Run code here to determine database to use
	#
	#When done, continue
	$site.database.name = ($mailboxcount.GetEnumerator() | sort value | select -first 1).key
	$site.timestamp.time = (Get-Date -Format o).ToString()
	$db.save($sourcexml)
	$site.database.name
	}

So I broke down the query being used to find where efficiency could be improved.  The Get-ExchangeServer cmdlet slows the script down and can be avoided altogether by feeding the server list directly into the Get-MailboxDatabase cmdlet.  Additionally, I discovered just how inefficient the Exchange cmdlets are.  I already knew they were based on running other cmdlets for targets servers across a WAN that return not a lot of data, but this reinforced those findings.

To get away from the Exchange cmdlets, I query AD directly by instantiating ADSI in .NET manually.  Instead of slowly building the hash table I just take the record count of the search results and populate the table entry at once.  This reduced the time to completion from 58 seconds to 24 seconds.  These findings are consistent across different database counts and mailbox totals: 60% reduction in time.  While still too long for my taste, it certainly is much better than before and is within reason for the people at my company that make use of the script.

Since my script encompasses more than just the load balancing part (I create a GUI form where the location for the mailbox is selected, which feeds a list of appropriate servers to the function), this is just the part that creates the hash table with the database counts and returns the database with the lowest count:

$mbxServers = @()
$mailboxcount = @{}
$domain = [System.DirectoryServices.ActiveDirectory.Domain]::GetCurrentDomain()
$root = [ADSI]"GC://$($domain.Name)"
$mbxServers | %{Get-MailboxDatabase -server $_} | ?{$_.recovery -eq $FALSE} | %{
$filter = "(&(objectcategory=user)(homeMDB=" + ($_.DistinguishedName) + "))"
$search = new-Object System.DirectoryServices.DirectorySearcher($root,$filter)
$search.PropertiesToLoad.Add("homeMDB") | Out-Null
$result = $search.FindAll()
$mailboxcount["$($_.Identity)"] = $result.count
}
($mailboxcount.GetEnumerator() | sort value | select -first 1).key

.\psexec \\server cmd /c "echo . | powershell (gci -path cert:\localmachine\my).notafter"

This script is a port of my original backup report that was written in VBScript.  That script reports on both 2003 and 2007 servers, but lacked some of the features that I wanted to put in.  PowerShell natively supports date-awareness, which makes it much easier to add the number one feature I wanted to add: highlighting servers that haven’t had backups since a specified period of time.

Because I am using the native Exchange cmdlets instead of WMI or CDOEXM, this only reports on Exchange 2007 servers.  I figure accommodating both is more work than it is worth, so I just modified my VBScript version to not include any server in the Exchange 12 admin group and I have both run every day until my migration to 2007 is complete.

The script reports the last successful full backup of any Exchange 2007 server with the mailbox role installed.  It checks for the presence of storage groups and databases within them.  It notes if a backup is currently in progress, as well as if a backup has never completed.  If a backup has not completed in the last 72 hours (modifiable), it is highlighted in red so it is easy to spot.  If a backup is less than the defined number of hours old, I use the Marlett font to display a green checkmark.  This allows for a checkmark without having to reference an external image or embed one.  Lastly, the report is emailed.  The script is shown below, but you can also just download it.

#Last Backup Report for Exchange 2007 servers
#Version 1.0 - 7/9/08
#--------------------------------------------

#Begin customization-------------------------
$SmtpServer = "server.domain.com" #Enter FQDN of SMTP server
$SmtpFrom = "Exchange Backups <exchangebackupreport@domain.com>" #Enter sender email address
$SmtpTo = "user1@domain.com","user2@domain.com" #Enter one or more recipient addresses in an array
$SmtpSubject = "Exchange 2007 Last Backup Report" #Enter subject of message
$iNomHours = "72" #Enter number of hours since last backup that requires attention
#End customization---------------------------

$date = Get-Date
$sSpace = "&nbsp;&nbsp;&nbsp;&nbsp;"
$sOutput = "<table>"

#Checkmark to indicate last backup within nominal time
$sCheckMark = "<span style=""font-family: Marlett; color: green; font-size: 14pt; font-weight: bold"">a</span>"

#Retrieve Exchange servers with mailbox role
$ExServer = Get-ExchangeServer | where {$_.IsMailboxServer -eq $True} | Sort-Object Name
Foreach ($server in $ExServer)
	{
	$sOutput += "<tr><td><font size=2><u><b>$server</b></u></font></td><td></td></tr>"
	#Retrieve storage groups for a given server
	$StorageGroup = $server | Get-StorageGroup | Sort-Object Name
	#Check for absence of any storage groups
	If (($StorageGroup | Measure-Object Name).Count -eq $null)
		{
		$sOutput += "<tr><td><font size=2>" + $sSpace + "No storage groups present.</font></td></tr>"
		}
	Else
		{
		Foreach ($sg in $StorageGroup)
			{
			$sOutput += "<tr><td><font size=2>" + $sSpace + $sg.Name + "</font></td></tr>"
			#Retrieve mailbox databases for a given storage group
			$MailboxDatabase = $StorageGroup | Get-MailboxDatabase -Status | Sort-Object Name
			#Check for absence of any databases in storage group
			If (($MailboxDatabase | Measure-Object Name).Count -eq $null)
				{
				$sOutput += "<tr><td><font size=2>" + $sSpace + $sSpace + "No mailbox stores present.</font></td></tr>"				}
			Else
				{
				Foreach ($db in $MailboxDatabase)
					{
					$sBackupRunning = ""
					#Note if backup is currently running
					If ($db.BackupInProgress -eq $true)
						{$sBackupRunning = "<font size=2 color=blue>(Backup In Progress)</font>"}
					#Determine if backup has ever completed
					If ($db.LastFullBackup -ne $null)
						{
						$sBackupDay = $db.LastFullBackup.get_DayofWeek()
						$sBackupDateTime = $db.LastFullBackup.ToString("g")
						#Flag if last completed backup started longer than defined variable
						If (($date - $db.LastFullBackup).TotalHours -gt $iNomHours)
							{
							$sLastBackup = "<font size=2>Last Backup Started At: <font color=red>" + $sBackupDay + ", " + $sBackupDateTime + "</font></font>"
							}
						Else
							{
							$sLastBackup = "<font size=2>Last Backup Started At: " + $sBackupDay + ", " + $sBackupDateTime + " </font>" + $sCheckmark
							}
						}
					Else
						{
						$sLastBackup = "<font size=2>No full backup has completed yet.</font>"
						}
					$sOutput += "<tr><td><font size=2>" + $sSpace + $sSpace + $db.Name + " </font></td><td>" + $sLastBackup + $sBackupRunning + "</td></tr>"
					}
				}
			}
		}
	}
$sOutput += "</table>"

#Email results
$SmtpClient = New-Object System.Net.Mail.SmtpClient
$MailMessage = New-Object System.Net.Mail.MailMessage
$SmtpClient.Host = $SmtpServer
$MailMessage.From = $SmtpFrom
Foreach ($address in $smtpTo)
	{$MailMessage.To.Add($address)}
$MailMessage.Subject = $SmtpSubject
$MailMessage.IsBodyHTML = $true
$MailMessage.Body = $sOutput
$SmtpClient.Send($MailMessage)

A side effect of this limitation is that you can also not enter a product key for a valid 64-bit server from a 32-bit installation such as the management tools on a 32-bit OS.  I have a PowerShell script that configures a server, depending on the roles that are installed.  However, the first thing it does for all servers is apply the product key.  This fails because I am running my configuration script from a 32-bit management installation.

I consider this a bug.  The only solution is to run the Set-ExchangeServer command with the -ProductKey parameter on a 64-bit installation of the management tools.

Microsoft KB 899663 instructs how to manually transpose GUID into a format that can be used in an LDAP filter so that you can search for a match.  Why do all this by hand when a script can do it for you?  I took an existing script I had that already does the transposition and added an AD search to return the matching dn.  The dn is passed to a name translation function that converts the dn to the NT4 format (domain\username) and displays the match with username and display name.

In addition to the VBScript file, I have also included a compiled version that uses SAPIEN Script Host as the engine.  This is a self-contained, runs-in-memory-only, no-DOS-box-comes-up engine from PrimalScript.  Running the compiled version is nice since you don’t have to ensure that CScript is the default host and no DOS box appears while the script is running.

The zip file with both versions is available here .

Like the original script, since we use automated DLs, too, I look for an indication that a given DL is a SmartDL and skip it.  And I now use PrimalScript to work with my scripts, so I use its packager to make an exectuable.  This makes it easier and nicer for non-IT end-users who will be running scripts like these.

Download it here, or copy/paste below.

'Version 2.0 - July 23, 2007
'Copy distribution group membership from one user to another,
'excluding automated DLs (SmartDL).
'Get source user
While Not bolExit = True
	strOldSamUser = InputBox("Enter the sAMAccountName of the person to copy DLs FROM." _
		, "Enter username")
	If strOldSamUser = "" Then
		WScript.Quit
	End If

	'Find the Global Catalog server
	Set objCont = GetObject("GC:")
	For Each objGC In objCont
		strADsPath = objGC.ADsPath
	Next

	Set objConnection = CreateObject("ADODB.Connection")
	Set objRecordset = CreateObject("ADODB.Recordset")
	objConnection.Provider = "ADsDSOObject"

	objConnection.Open "ADs Provider"
	strQuery = "<" & strADsPath & ">;(&(objectcategory=user)(sAMAccountName=" & strOldSamUser & _
		"));displayName,distinguishedName;subtree"
	Set objRecordset = objConnection.Execute(strQuery)

	If Trim(objRecordset.Fields("distinguishedName")) = "" Then
		strNoUser = MsgBox("Warning: User cannot be found.  Verify sAMAccountName.", vbCritical, "User not found!")
		bolExit = False
	Else
		intCorrectUser = MsgBox("Is this the correct user?" & VbCrLf & VbCrLf & "Display Name: " & _
		objRecordset.Fields("displayName") & VbCrLf & "DN: " & objRecordset.Fields("distinguishedName"), _
			vbYesNo, "Old user?")
		If intCorrectUser <> 6 Then
			bolExit = False
		Else
			strSrcDN = objRecordset.Fields("distinguishedName")
			bolExit = True
		End If
	End If
 Wend
'Open IE to display progress and results
Set objIE = CreateObject("InternetExplorer.Application")
objIE.AddressBar = False
objIE.Menubar = False
objIE.Toolbar = False
objIE.Resizable = True
objIE.Left = 10
objIE.Height = 450
objIE.Width = 800
objIE.Visible = True
objIE.Navigate("about:blank")
While objIE.Busy
	WScript.Sleep 100
Wend
Set objDoc = objIE.Document
objDoc.Open
objDoc.Write("<TITLE>Copy DL Membership</TITLE>")
objDoc.Write("<BODY BGCOLOR=#C0C0C0>")
objDoc.Write("<P><b>Source:</b> " & objRecordset.Fields("distinguishedName") & "<br>")
'Get target user
bolExit = False
While Not bolExit = True
	strNewSamUser = InputBox("Enter the sAMAccountName of the person to copy DLs TO." _
		, "Enter username")
	If strNewSamUser = "" Then
		objIE.Quit
		WScript.Quit
	End If
	strQuery = "<" & strADsPath & ">;(&(objectcategory=user)(sAMAccountName=" & strNewSamUser & _
		"));displayName,distinguishedName;subtree"
	Set objRecordset = objConnection.Execute(strQuery)
	If Trim(objRecordset.Fields("distinguishedName")) = "" Then
		strNoUser = MsgBox("Warning: User cannot be found.  Verify sAMAccountName.", vbCritical, "User not found!")
		bolExit = False
	Else
		intCorrectUser = MsgBox("Is this the correct user?" & VbCrLf & VbCrLf & "Display Name: " & _
			objRecordset.Fields("displayName") & VbCrLf & "DN: " & objRecordset.Fields("distinguishedName"), _
			vbYesNo, "Old user?")
		If intCorrectUser <> 6 Then
			bolExit = False
		Else
			Set objTargetUser = GetObject("LDAP://" & objRecordset.Fields("distinguishedName"))
			bolExit = True
		End If
	End If
 Wend
 'Write target user to IE window
 objDoc.Write("<b>Target:</b> " & objRecordset.Fields("distinguishedName") & "</P>")
 'Copy DLs
 strDomFQDN = Mid(strSrcDN, InStr(LCase(strSrcDN), ",dc=") + 4)
 strGCFQDN = Replace(LCase(strDomFQDN), ",dc=", ".")
 Set objOldUser = GetObject("GC://" & strGCFQDN & "/" & strSrcDN)
 For Each strGroup in objOldUser.MemberOf
	On Error Resume Next
	Set objGroup = GetObject("LDAP://" & strGroup)
	If Not Trim(objGroup.mailNickname) = "" Then
		If Not Instr(objGroup.info, "SmartDL") > 0 Then
			objGroup.Add(objTargetUser.ADsPath)
			If Err.Number = 0 Then
				objDoc.Write(objGroup.DisplayName & ": Update successful.<br>")
			Else
				objDoc.Write(objGroup.DisplayName & ": Update UNSUCCESSFUL.<br>")
			End If
		Else
			objDoc.Write(objGroup.DisplayName & ": Skipped (SmartDL).<br>")
		End If
	End If
	On Error Goto 0
 Next

 Set objOldUser = Nothing
 Set objTargetUser = Nothing
 Set objIE = Nothing
 Set objRecordset = Nothing
 Set objConnection = Nothing
 

It is not uncommon at my company to have to move a user from one domain to another for technical, logistical, or political reasons.  For another set of reasons, moving the user account to the other domain is not done, instead manually creating a new one and associating the mailbox with the new account.

DL membership does not automatically get updated when this is done, so I have been doing it manually.  It has been on my to-do list for awhile to write a script to copy the DL membership from the old account to the new one.  So I threw this together this morning.  It lacks some of the nice extras my other scripts have (finding the user by logon name, email results, true logging) but it does work.

You have to edit the script to give it the variables for the old and new users’ dn.  It will skip security groups (any group without an alias) and also groups whose Notes (info) attribute contains the word SmartDL.  We use Imanami’s SmartDL for automated DL membership when applicable.  Those will be automatically updated the next time each of their jobs run.

Download it here, or copy/paste below.

Option Explicit
Dim strOldUser, strNewUser, objOldUser, objNewUser, strGroup, objGroup
strOldUser = "" 'dn of user to copy from'
strNewUser = "" 'dn of user to copy to'
Set objOldUser = GetObject("LDAP://" & strOldUser)
Set objNewUser = GetObject("LDAP://" & strNewUser)
wscript.echo "Source user: " & objOldUser.DisplayName
wscript.echo "Target user: " & objNewUser.DisplayName
For Each strGroup in objOldUser.MemberOf
	On Error Resume Next
	Set objGroup = GetObject("LDAP://" & strGroup)
    If Not Trim(objGroup.mailNickname) = "" Then
        If Not Instr(objGroup.info, "SmartDL") > 0 Then
			objGroup.Add(objNewUser.ADsPath)
			If Err.Num = 0 Then
				wscript.echo objGroup.DisplayName & ": Update successful."
			Else
				wscript.echo objGroup.DisplayName & ": Update UNSUCCESSFUL."
			End If
        Else
			wscript.echo objGroup.DisplayName & ": Skipped (SmartDL)."
        End If
	End If
	On Error Goto 0
Next
Set objOldUser = Nothing
Set objNewUser = Nothing

I have updated the script, which can be downloaded here, to search for the groups based on their objectGUID, which never changes no matter what you do to the object (rename, move, etc.).  Instead of hard-coding the dn of the object, I hard-code the objectGUID.  Then I bind directly to the object based on the GUID to retrieve its dn, which is used in the search filter to find the users I want to modify.

Note that ADO allows you to bind to an object given just its GUID, without having to specify other connection parameters.  You can also use the hexadecimal or binary format of the GUID in the connection string; AD will figure out which format you are using. I used the binary format in my script so that I could just copy and paste the value from Hyena into my script without having to convert to a hex value.

Glen’s script uses an input argument of a server name. My distributed environment doesn’t allow for such a broad application, so I use the membership of a DL that contains the IT personnel. This DL actually contains other DLs, so I separately use another script by Richard Mueller that enumerates nested groups and puts the results into a domain local group that is used for other purposes.

After getting the group members, I loop through each member for only those with a mailbox that isn’t hidden. For those who haven’t been touched by the script before, a function is called that uses CDO to log into the mailbox, enumerate the calendar permissions looking for the Default entry, and change it to Reviewer. The user’s local FreeBusy Data folder is also updated to set the Default to Editor since that permission goes hand in hand when setting permissions on the calendar.

To keep tabs on who the script has touched, a notation is added to extensionAttribute4 (customizable). Those with that notation are skipped in the future. Then an email is sent to the user informing them of the change. I chose to do this because Exchange users may be used to the fact the the Default permission is None; this way they are aware that their calendar is open for viewing. It also helps with new employees who are not aware of this "policy" and can mark items as Private as necessary.

Finally, an email is sent to the admin with the results of the job run. It includes the display name, mailbox server, and whether the permission was set or the object skipped (to catch entries that slip through my filter). I have scheduled this to run weekly, and I will get an email each time so I know that the script is successfully running and which users are being modified.

All of the variables that require customization are near the top. These are for mail configuration, search filter, and the notation parameters for touched mailboxes.

Download it here or copy below.

Option Explicit

Public Const CdoDefaultFolderCalendar = 0
Dim strSMTPServer, strMailFrom, strUserMailSubject, strUserMailBody
Dim strAdminMailRecip, strAdminMailSubject, strAdminMailBody
Dim strDefaultNamingContext, strQueryFilter, strAttName, strAttNote
Dim conn, com, iAdRootDSE, strNamingContext
Dim Rs, objGroup, strMember, objUser, strMsExchHomeServerName
Dim objSession, CdoInfoStore, CdoFolderRoot, ACLObj, CdoCalendar, FolderACEs, fldACE
Dim objRoot, objFreeBusyFolder

'Configuration parameters:
''''''''''''''''''''''''''''''''''''''''''''''
'Email notification configuration
strSMTPServer = "server.company.com" 'FQDN of SMTP server
strMailFrom = """Display Name"" <a href="mailto:SMTPAddress@company.com">SMTPAddress@company.com</a>" ' Display name and address of sender
strUserMailSubject = "The default permission on your calendar has been updated" 'Subject of message sent to users
strUserMailBody = "In order to promote effective collaboration among the Company " & _
    "employees, the Default permission on your calendar has been updated to Reviewer.  This allows anyone within the organization " & _
    "to see the details of items within your calendar.  For items that are of a sensitive, confidential, or personal nature, " & _
    "you can mark them as Private.  This will restrict the details of the item so that others cannot see the subject or body.  " & _
    "If you have any questions about this change, please reply to this message or contact the Help Desk at XXXX.<br><br>" & _
    "Company Messaging and Collaboration Team (GAL Display Name)<br>Department<br>Company" 'Body of message sent to users
strAdminMailRecip = "<a href="mailto:SMTPAddress@company.com">SMTPAddress@company.com</a>" 'Address of admin to receive status report
strAdminMailSubject = "Default calendar permission change report" 'Subject of message sent to admin
'Domain to search for object
strDefaultNamingContext = "dc=company,dc=com" 'AD FQDN of base scope to search
'Search filter for group with users
strQueryFilter = "(&(objectcategory=group)(displayName=something))" 'LDAP filter to locate group with members to modify

'Attribute and notation for updated objects
strAttName = "extensionAttribute4" 'defined for a single-valued string attribute
strAttNote = "DefaultCalSet" 'Notation used to skip processed users on future script runs
''''''''''''''''''''''''''''''''''''''''''''''
strAdminMailBody = ""
Set conn = createobject("ADODB.Connection")
Set com = createobject("ADODB.Command")
Set iAdRootDSE = GetObject("<a href="ldap://RootDSE">LDAP://RootDSE</a>")
strNamingContext = iAdRootDSE.Get("configurationNamingContext")
Conn.Provider = "ADsDSOObject"
Conn.Open "ADs Provider"
Com.ActiveConnection = Conn
com.Properties("Page Size") = 1000
Com.CommandText = "<GC://" & strDefaultNamingContext & ">;" & StrQueryFilter & ";distinguishedname;subtree"
Set Rs = Com.Execute
While Not Rs.EOF
	Set objGroup = GetObject("LDAP://" & Rs.fields("distinguishedname"))
	For each strMember in objGroup.Member
		Set objUser = GetObject("LDAP://" & strMember)
		If InStr(objUser.Get(strAttName), strAttNote) < 1 Then
			strAdminMailBody = strAdminMailBody & objUser.displayName & "<br>"
			If objUser.Class = "user" And Not IsNull(objUser.msExchHomeServerName) And Not UCase(objUser.msExchHidefromAddressLists) = "TRUE" Then
				strMsExchHomeServerName = objUser.msExchHomeServerName
				strMsExchHomeServerName = right(strMsExchHomeServerName,len(strMsExchHomeServerName)-instrrev(strMsExchHomeServerName,"/cn=")-3)
				strAdminMailBody = strAdminMailBody & "&nbsp;&nbsp;&nbsp;&nbsp;" & strMsExchHomeServerName & "<br>"
				Call dofreebusy(strMsExchHomeServerName, objUser.mailNickname)
				strAdminMailbody = strAdminMailBody & "&nbsp;&nbsp;&nbsp;&nbsp;Permission set on: " & objUser.mailNickname & "<br>"
				WriteTag
				SendEmail objUser.mail, strUserMailSubject, strUserMailBody
			Else
				strAdminMailBody = strAdminMailBody & "&nbsp;&nbsp;&nbsp;&nbsp;Skipping object<br>"
			End If
		End If
	Next
	Rs.MoveNext
Wend
Rs.Close

'Send admin email report
If Not strAdminMailBody = "" Then
	strAdminMailBody = strAdminMailBody & "<br>Done.<br>"
Else
	strAdminMailBody = "No mailboxes needed updating."
End If
SendEmail strAdminMailRecip, strAdminMailSubject, strAdminMailBody

Set conn = Nothing
Set com = Nothing

Function dofreebusy(serverName, mailboxName)
	'Set Default permission to Reviewer
	Set objSession = CreateObject("MAPI.Session")
	objSession.Logon "","",false,true,0,true,servername & vbLF & mailboxname
	Set CdoInfoStore = objSession.GetInfoStore
	Set CdoFolderRoot = CdoInfoStore.RootFolder
	Set ACLObj = CreateObject("MSExchange.aclobject")
	Set CdoCalendar = objSession.GetDefaultFolder(CdoDefaultFolderCalendar)
	ACLObj.CdoItem = CdoCalendar
	Set FolderACEs = ACLObj.ACEs
	For each fldACE in FolderACEs
		If fldACE.ID = "ID_ACL_DEFAULT" Then
			fldACE.Rights = 1025
			ACLObj.Update
		End If
	Next

	'Set local FreeBusy folder permission to Editor
	Set objRoot = objSession.GetFolder("")
	Set objFreeBusyFolder = objRoot.Folders.Item("FreeBusy Data")
	ACLObj.CdoItem = objFreeBusyFolder
	Set FolderACEs = ACLObj.ACEs
	For each fldACE in FolderACEs
		If fldACE.ID = "ID_ACL_DEFAULT" Then
		fldACE.Rights = 1123
		ACLObj.Update
		End If
	Next
End function

'Write notation tag into attribute
Sub WriteTag()
	If IsNull(objUser.Get(strAttName)) or IsEmpty(objUser.Get(strAttName)) Then
		objUser.Put strAttName, strAttNote & ";"
	Else
		Dim strExistAttName
		strExistAttName = objUser.Get(strAttName)
		objUser.Put strAttName, strExistAttName & strAttNote & ";"
	End If
	objUser.SetInfo
End Sub

'Send change notification and report
Sub SendEmail (strRecipAddress, strMailSubject, strMailBody)
	Dim objMail
	Set objMail = CreateObject("CDO.Message")
	objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSMTPServer
	objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	objMail.Configuration.Fields.Update

 objMail.From = strMailFrom
	objMail.To = strRecipAddress
	objMail.Subject = strMailSubject
	objMail.HTMLBody = strMailBody
	objMail.Send
	Set objMail = Nothing
End Sub

I had written a batch file long ago to change the bitmask attribute for users whose mobile services are enabled for everything (0) and are not in the appropriate DL of authorized users to disable only EAS (5).  It was an inefficient script that required explicit permissions for each domain, called a command-line regex tool to format the ldifde export, and was prone to errors.

This updated script accomplishes the same thing, but more efficiently.  It processes all users at one time (inside a for loop) and uses implicit permissions.  It even emails the results of the number of users modified.  The script is customized for my environment, but you can tweak it as necessary. 

I have five user domains, but the DLs for authorization are in one domain.  I wanted it to be as dynamic as possible, but balancing that with all the extra code necessary to make every piece not rely on hard-coded information.  So you need to provide mail config information, the NetBIOS domain names you want to loop through, and the dn of the groups for each user domain.  The GC to search and the DC to make the change to will be determined automatically.

Download it here or copy below.

Option Explicit

Dim mailFrom, mailTo, mailSubject, mailBody, mailServer
Dim objConnection, objCommand, objRecordSet, objUser, objGC, objDomain
Dim strGCPath, strNBDomain, strdomain, arrDomains, strCount
dim strSearchFilter, strEASDL, strDomainPath
strCount = ""

'Mail config
mailFrom = Wscript.ScriptName & "@company.com"
mailTo = "user@company.com"
mailSubject = "EAS Disable Results"
mailBody = ""
mailServer = "server.company.com"

'AD connection parameters
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

'Get FQDN of a GC
Set objGC = GetObject("GC://RootDSE")
strGCPath = objGC.Get("dnsHostName")

'Query each domain and call disable subroutine
arrDomains = array("domainA", "domainB", "domainC", "domainD", "domainE")
For each strDomain in arrDomains
	subOMADisable strdomain
Next

'Email results
Call subSendMail(mailFrom, mailTo, mailSubject, strCount, mailServer)

'Sub to change attribute value
Sub subOMADisable(strNBDomain)
	'Get base DN of domain
	Set objDomain = GetObject("LDAP://" & strNBDomain & "/RootDSE")
	strDomainPath = objDomain.Get("DefaultNamingContext")
	Set objDomain = Nothing

	Select Case strNBDomain
		Case "domainA"
			strEASDL = "dn of groupA"
		Case "domainB"
			strEASDL = "dn of groupB"
		Case "domainC"
			strEASDL = "dn of groupC"
		Case "domainD"
			strEASDL = "dn of groupD"
		Case "domainE"
			strEASDL = "dn of groupE"
	End Select
	strSearchFilter="(&(objectcategory=user)(mailnickname=*)(homeMDB=*)(!memberof=" & strEASDL & ")(!msExchOMAAdminWirelessEnable=5))"
	objCommand.CommandText = "<GC://" & strGCPath & "/" & strDomainPath & ">;" & strSearchFilter & ";distinguishedname;subtree"
	Set objRecordSet = objCommand.Execute
	If objRecordSet.RecordCount > 0 Then
		While Not objRecordSet.EOF
			Set objUser = GetObject("LDAP://" & objRecordSet.Fields("distinguishedname"))
			'wscript.echo objUser.DisplayName
			objUser.Put "msExchOMAAdminWirelessEnable", "5"
			objUser.SetInfo
			objRecordSet.MoveNext
		Wend
	End If
	strCount = strCount & vbTAB & strNBDomain & ": " & objRecordSet.RecordCount & vbCRLF
End Sub

'Sub to send email with results
Sub subSendMail (mFrom, mTo, mSubject, mBody, mServer)
	Dim objEmail
	Set objEmail = CreateObject("CDO.Message")
	objEmail.From = mFrom
	objEmail.To = mTo
	objEmail.Subject = mSubject
	objEmail.Textbody = "Objects modified in each domain:" & vbCRLF &vbCRLF & mBody
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver") = mServer
	objEmail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	objEmail.Configuration.Fields.Update
	objEmail.Send
End Sub

'Cleanup
Set objUser = Nothing
Set objCommand = Nothing
Set objGC = Nothing
Set objConnection = Nothing

Using MFCMapi to look at the properties of a conflict message, there are several properties that you’d think you could use, but when setting up a rule to use properties of the conflict message form, none of he properties are available.  And if you manually type in property name it gives you an error.

In the end, I tried setting the rule again to fire on subject contains "Conflict Message:" and it worked.  Huh.  So who knows what I was doing wrong before?  You can also have the rule fire if the message form is "Conflict Message."

However, at my office we don’t have these kinds of users in one OU.  They are spread across multiple domains, but are all in a local group that has permission to a web page that allows them to change their password.  So I updated the script to enumerate the members of this group.  To accommodate different password aging settings in each domain I moved the domain query for this setting into the For loop.  I also added logging so you will have a record of what was sent, not sent, and why.  This way you can schedule it or run it interactively without having to adjust the code.  Download it here, or copy below.

Option Explicit

' Per environment constants - you should change these
Const SMTP_SERVER  = "ServerName"
Const STRFROM   = "From SMTP Address"
Const DAYS_FOR_EMAIL  = 14 'Send notification when pwd will expire in this number of days
Const GROUPDN = "DN of group to enumerate"
Const LOGFILE = "Patch and filename of log file"

' System Constants - do not change
Const ONE_HUNDRED_NANOSECOND    = .000000100   ' .000000100 is equal to 10^-7
Const SECONDS_IN_DAY            = 86400
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
Const E_ADS_PROPERTY_NOT_FOUND  = &h8000500D

' Change to "True" for extensive debugging output
Const bDebug   = False

Dim numDays, iResult
Dim strDomain
Dim objGroup, objMember, member
Dim objFSO, objFile, strOutput

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(LOGFILE, 8, True)

Set objGroup = GetObject("LDAP://" & GROUPDN)
objFile.WriteLine "Executed at " & Now() & vbCRLF
objFile.WriteLine "Enumerating members of " & objGroup.distinguishedName & ":" & vbCRLF
For each member in objGroup.member
	Set objMember = GetObject("LDAP://" & member)
	objFile.WriteLine objMember.distinguishedname
	strDomain = Mid(objMember.distinguishedname, InStr(objMember.distinguishedname, "DC="))
	numdays = GetMaximumPasswordAge (strDomain)
	Call ProcessUser (numDays)
Next

objFile.WriteLine "Done. Finished at " & Now() & "."
objFile.Close

Function GetMaximumPasswordAge (ByVal strDomainDN)
	Dim objDomain, objMaxPwdAge
	Dim dblMaxPwdNano, dblMaxPwdSecs, dblMaxPwdDays

	Set objDomain = GetObject("LDAP://" & strDomainDN)
	Set objMaxPWdAge = objDomain.maxPwdAge

	If objMaxPwdAge.LowPart = 0 And objMaxPwdAge.Highpart = 0 Then
		' Maximum password age is set to 0 in the domain
		' Therefore, passwords do not expire
		GetMaximumPasswordAge = 0
	Else
		dblMaxPwdNano = Abs (objMaxPwdAge.HighPart * 2^32 + objMaxPwdAge.LowPart)
		dblMaxPwdSecs = dblMaxPwdNano * ONE_HUNDRED_NANOSECOND
		dblMaxPwdDays = Int (dblMaxPwdSecs / SECONDS_IN_DAY)
		GetMaximumPasswordAge = dblMaxPwdDays
	End If
End Function

Function UserIsExpired (objMember, iMaxAge, iDaysForEmail, iRes)
	Dim intUserAccountControl, dtmValue, intTimeInterval
	Dim strName
	On Error Resume Next
	Err.Clear
	strName = Mid (objMember.Name, 4)
	intUserAccountControl = objMember.Get ("userAccountControl")

	If intUserAccountControl And ADS_UF_DONT_EXPIRE_PASSWD Then
		dp "The password for " & strName & " does not expire."
		UserIsExpired = False
	Else
		iRes = 0
		dtmValue = objMember.PasswordLastChanged
		If Err.Number = E_ADS_PROPERTY_NOT_FOUND Then
			UserIsExpired = True
			dp "The password for " & strName & " has never been set."
		Else
			intTimeInterval = Int (Now - dtmValue)
			dp "The password for " & strName & " was last set on " & _
			DateValue(dtmValue) & " at " & TimeValue(dtmValue) & _
			" (" & intTimeInterval & " days ago)"
			If intTimeInterval >= iMaxAge Then
				dp "The password for " & strName & " has expired."
				UserIsExpired = True
			Else
				iRes = Int ((dtmValue + iMaxAge) - Now)
				dp "The password for " & strName & " will expire on " & _
				DateValue(dtmValue + iMaxAge) & " (" & _
				iRes & " days from today)."
				If iRes <= iDaysForEmail Then
					dp strName & " needs an email for password change"
					UserIsExpired = True
				Else
					dp strName & " does not need an email for password change"
					'Swap commented variable below to force email to be sent (for testing).
					UserIsExpired = False
					'UserIsExpired = True
				End If
			End If
		End If
	End If
End Function

Sub ProcessUser (iMaxPwdAge)
	Dim iResult, strExpire
	If Right (objMember.Name, 1) <> "$" Then
		If IsEmpty (objMember.Mail) or IsNull  (objMember.Mail) Then
			dp Mid (objMember.Name, 4) & " has no mailbox"
		Else
			If UserIsExpired (objMember, iMaxPwdAge, DAYS_FOR_EMAIL, iResult) Then
				objFile.WriteLine "Sending an email to " & objMember.givenName & " " & objMember.sn & _
				" (" & objMember.Mail & ").  Password expires in " & iResult & " days." & vbCRLF
				Call SendEmail (iResult)
			Else
				If iResult = "" Then
					strExpire = "."
				Else
					strExpire = " for " & iResult & " days."
				End If
				objFile.WriteLine "Skipping " & objMember.givenName & " " & objMember.sn & _
				". Password does not expire" & strExpire & vbCRLF
			End If
		End If
	End If
End Sub

Sub SendEmail (iResult)
	Dim objMail
	Set objMail = CreateObject ("CDO.Message")
	objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/sendusing")      = 2
	objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserver")     = SMTP_SERVER
	objMail.Configuration.Fields.Item ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
	objMail.Configuration.Fields.Update

	objMail.From = STRFROM
	objMail.To = objMember.Mail

	objMail.Subject = "The Windows password is going to expire for " & Mid (objMember.Name, 4)
	objMail.Textbody = "The Windows Active Directory password for user " & objMember.givenName & " " & objMember.sn & _
	" (" & objMember.sAMAccountName & ")" & " will expire in " & iResult & " days. " & vbCRLF & vbCRLF & _
	"Please use Outlook Web Access (https://www.company.com) to change it before it expires." & vbCRLF & vbCRLF & _
	"Thank you," & vbCRLF & _
	"Company Exchange Team" & vbCRLF & vbCRLF & _
	"Note: You have received this email because you are a member of a group that is authorized to change your " & _
	"password via Outlook Web Access since you do not log in to the corporate network.  If this no longer applies to you, " & _
	"please notify the Company Email Team (SMTPAddress) so you can be removed from the group."

	objMail.Send
	Set objMail = Nothing
End Sub

Sub dp (str)
	If bDebug Then
		objFile.WriteLine str
	End If
End Sub