The Christmas Sessions was released on September 27. I ordered it in early October, shipping via media mail. Wow. That is like shipping via mule. I think it took two weeks to arrive. I don’t recommend it unless you really are in no hurry to get your item. Upon first listening, I was a bit disenchanted like I was with Hymned since the songs aren’t originals by MercyMe. Track 1 is a little too heavy for my taste, at least for Christmas music. But after listening to the entire album again I warmed up to it. What makes it more enjoyable each time are the arrangements. My favorite track, Silent Night, has such a MercyMe sound to it that it points out to me how much I enjoy their musical style and Bart’s arranging and voice.
Yearly Archives: 2005
Query for a mailbox’s size and quota
There are a lot of scripts out there to report a mailbox’s current size and others to report the quota for a mailbox. And some might even do both, but for an entire domain, server, etc. I wanted one that I could use to list a single mailbox’s current size and where it falls within its quota.
This script allows you to find a user based on login name (samAccountName) or email address. If multiple matches are found it will report on all of them. It uses WMI to query Exchange for the mailbox’s current size and then uses LDAP to determine the quota. Since there are multiple places a quota can be set (system policy, server, mailbox), the script factors those in and backtracks to the resulting quota in effect.
The results are output to the screen and to a popup window. And since it is nice to know, it also will display if default or custom limits are in use. This script is nice because you don’t have to customize anything. Just download\copy it and run it.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 |
Option Explicit Dim objGC, objOU, strADPath Dim strUserLoginName Dim objADOCnxn, objADOCmd, strSearchFilter, strReturnAttrib, strSearchDepth, objResults, intMatchingRecords Dim strUserDisplayName, strRawExchServer, strExchServer Dim wmiConn, strWQL, wmiColl, wmiObj Dim mbstore, strquota, stroverquota, strHardLimit, strmbsize, strquotasum ' ' Messages to be displayed if the scripting host is not cscript ' Const kMessage1 = "Please run this script using CScript." Const kMessage2 = "This can be achieved by" Const kMessage3 = "1. Using ""CScript script.vbs arguments"" or" Const kMessage4 = "2. Changing the default Windows Scripting Host to CScript" Const kMessage5 = " using ""CScript //H:CScript //S"" and running the script " Const kMessage6 = " ""script.vbs arguments""." ' Make sure running with CScript If Not IsHostCscript() Then Call WScript.echo(kMessage1 & vbCRLF & kMessage2 & vbCRLF & _ kMessage3 & vbCRLF & kMessage4 & vbCRLF & _ kMessage5 & vbCRLF & kMessage6 & vbCRLF) WScript.quit End If ' Connect to a global catalog for the forest Set objGC = GetObject("GC:") For Each objOU In objGC strADPath = "<" & objOU.AdsPath & ">" Next Set objOU = Nothing Set objGC = Nothing WScript.Echo "* Searching within: " & strADPath ' Get input - strUserLoginName strUserLoginName = InputBox("This will search for the user's mailbox and display its size." & _ vbCrLf & vbCrLf & "Enter a user's login name, or" & vbCrLf & "their primary SMTP address:" & _ vbCrLf & vbCrLf & "(LDAP wildcard characters are supported.)") If strUserLoginName = "" Then WScript.Echo "User Canceled" WScript.Quit End If ' Use ADO to query on the given user login name Set objADOCnxn = CreateObject("ADODB.Connection") objADOCnxn.Provider = "ADsDSOObject" objADOCnxn.Open "Active Directory Provider" Set objADOCmd = CreateObject("ADODB.Command") objADOCmd.ActiveConnection = objADOCnxn strSearchFilter ="(&(objectCategory=person)(|(mail=" & strUserLoginName & ")(samAccountName=" & strUserLoginName & ")))" strReturnAttrib = "displayName,msExchHomeServerName,samAccountName,mdbUseDefaults,homemdb,mDBStorageQuota,mDBOverQuotaLimit,mDBOverHardQuotaLimit" strSearchDepth = "SubTree" objADOCmd.CommandText = strADPath & ";" & strSearchFilter & ";" & strReturnAttrib & ";" & strSearchDepth Set objResults = objADOCmd.Execute intMatchingRecords = objResults.RecordCount WScript.Echo " AD Search Returned " & intMatchingRecords & " Records" & vbCrLf If intMatchingRecords < 1 Then ' User name was not found MsgBox "The specified string was not found!" & vbCrLf & vbCrLf & "No matching user name or SMTP address(es)", 0, "Search Results" Else ' We found a match, for each record in result set... Do strUserDisplayName = objResults.Fields("displayName").value strRawExchServer = objResults.Fields("msExchHomeServerName").value ' only proceed if the msExchHomeServerName attribute contains an '=' character If InStr(1, strRawExchServer, "=", vbTextCompare) Then ' Parse out the actual Exchange server name (everything to right of last '=') strExchServer = Mid(strRawExchServer,InStrRev(strRawExchServer, "=", -1, vbTextCompare) + 1) ' Create a WMI connection to that server Set wmiConn = GetObject("WinMgmts:{impersonationLevel=impersonate}!\\" & strExchServer & "\root\microsoftexchangev2") ' Search for the display name of the user WScript.Echo "* Looking for '" & strUserDisplayName & "' on server " & strExchServer strWQL = "SELECT * FROM Exchange_Mailbox WHERE MailboxDisplayName = '" & strUserDisplayName & "'" 'WScript.Echo " DEBUG " & strWQL WScript.Echo " Searching... Please wait" Set wmiColl = wmiConn.ExecQuery(strWQL) If wmiColl.Count >= 1 Then ' Get quota limits If objResults.Fields("mDBUseDefaults").value = true Then Set mbstore = GetObject("GC://" & objResults.Fields("homemdb")) If mbstore.mDBStorageQuota = "" Then strquota = "No Quota" Else strquota = formatnumber(mbstore.mDBStorageQuota/1024,0) End if If mbstore.mDBOverQuotaLimit = "" Then stroverquota = "No Quota" Else stroverquota = formatnumber(mbstore.mDBOverQuotaLimit/1024,0) End if If mbstore.mDBOverHardQuotaLimit = "" Then strHardLimit = "No Quota" Else strHardLimit = formatnumber(mbstore.mDBOverHardQuotaLimit/1024,0) End if If strquota <> "No Quota" Then strquotasum = " Storage Quotas (Using store limits):" & vbcrlf strquotasum = strquotasum & " Warning Limit: " & strquota & " MB" & vbcrlf strquotasum = strquotasum & " Prohibit Send: " & stroverquota & " MB" & vbcrlf strquotasum = strquotasum & " Prohibit Receive: " & strHardLimit & " MB" & vbcrlf Else strquotasum = "Storage Limits: No Quotas Configured" & vbcrlf End if Else If IsNull(objResults.fields("mDBStorageQuota").value) Then strquota = "No Quota" Else strquota = formatnumber(objResults.fields("mDBStorageQuota").value/1024,0) & " MB" End if If IsNull(objResults.fields("mDBOverQuotaLimit").value) Then stroverquota = "No Quota" Else stroverquota = formatnumber(objResults.fields("mDBOverQuotaLimit").value/1024,0) & " MB" End if If IsNull(objResults.fields("mDBOverHardQuotaLimit").value) Then strHardLimit = "No Quota" Else strHardLimit = formatnumber(objResults.fields("mDBOverHardQuotaLimit").value/1024,0) & " MB" End if strquotasum = " Storage Quotas (Using custom limits):" & vbcrlf strquotasum = strquotasum & " Warning Limit: " & strquota & vbcrlf strquotasum = strquotasum & " Prohibit Send: " & stroverquota & vbcrlf strquotasum = strquotasum & " Prohibit Receive: " & strHardLimit & vbcrlf End if ' for each mailbox found (should only be one), display the size For Each wmiObj In wmiColl WScript.Echo " Found: " & wmiObj.MailboxDisplayName WScript.Echo " Mailbox Size: " & formatnumber(wmiObj.Size/1024,1) & " MB" & vbCrLf Wscript.Echo strquotasum MsgBox " Mailbox: " & strUserDisplayName & vbcrlf & " Size: " & formatnumber(wmiObj.Size/1024,1) & _ " MB" & vbcrlf & vbcrlf & strquotasum, 0, "Search Results" Next Else ' No mailbox found MsgBox "'" & strUserDisplayName & "' mailbox was not found on server " & strExchServer, 0, "Search Results" End If Set wmiColl = Nothing Set wmiConn = Nothing Else WScript.Echo "* No Exchange Home Server defined for " & objResults.Fields("samAccountName").value & vbCrLf End If 'move to the next record in the record set; quit when EOF is true objResults.MoveNext Loop until objResults.EOF End If Set objResults = Nothing Set objADOCmd = Nothing Set objADOCnxn = Nothing WScript.Echo "Done!" WScript.Quit ' Determines which program is used to run this script. ' Returns true if the script host is cscript.exe Function IsHostCscript() On Error Resume Next Dim strFullName Dim strCommand Dim i, j Dim bReturn bReturn = False strFullName = WScript.FullName i = InStr(1, strFullName, ".exe", 1) If i <> 0 Then j = InStrRev(strFullName, "\", i, 1) If j <> 0 Then strCommand = Mid(strFullName, j+1, i-j-1) If LCase(strCommand) = "cscript" Then bReturn = True End If End If End If If Err <> 0 Then Call WScript.echo("Error 0x" & Hex(Err.Number) & " occurred. " & Err.Description _ & ". " & vbCRLF & "The scripting host could not be determined.") End If IsHostCscript = bReturn End Function |
SVCC sermons now available via podcast
Prior to July 31, Summit View’s sermons were only available via copies of an analog tape recording. So I took it upon myself to bring SVCC into the late 20th century by digitally recording the service. I do some minor editing (like removing silence that works fine with a visual service but is awkward when listening only to the audio portion) and make them available in MP3 and WMA formats. In addition, I make a mixed mode CD with both the CD audio portion and a data portion containing the mp3 and wma files.
Then I was recently asked about making the sermon (or message as we call it) available on iTunes so it can be downloaded automatically and listened to on the go. So, to bring SVCC into the 21st century, the message of the week is available as a podcast. You can subscribe to it by searching for the keywords Summit View, or you can subscribe manually (or for anyone who doesn’t want to use iTunes and has another reader they want to use). The feed is at http://www.flobee.net/SVCC/podcast.xml.
Report the last time your Exchange servers were backed up
Like a lot of my scripts, they start from the hard work that someone else has done. This one began as a similar script that Glen Scales wrote and posted over on his blog. His version enumerates the servers/stores in a domain and outputs the results to the screen.
My needs required some tweaking since I have servers in multiple domains, and I wanted it to email the results to multiple people who are responsible for backups. I also needed to account for servers that don”t have public and/or private stores (e.g., front-end servers, conferencing servers). The script will email the report in HTML format, grouping the stores alphabetically by server name. Change the constants at the top to suit your needs and then schedule it to run daily. My next step is to note stores that haven”t been backed up in X days (perhaps two or three) and highlight them in red so it is easy to spot those stores (since my report currently has 60+ stores in it). Until then, download this version here, or copy it below.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 |
'Change the constants below CONST strSMTPServer = "Change to server name" CONST strSMTPRecipient = "Change to recipient address(es)" CONST strSMTPSender = "Change to sender address" set conn = createobject("ADODB.Connection") set mdbobj = createobject("CDOEXM.MailboxStoreDB") set pdbobj = createobject("CDOEXM.PublicStoreDB") set com = createobject("ADODB.Command") Set iAdRootDSE = GetObject("<a href="ldap://RootDSE/">LDAP://RootDSE</a>") strNameingContext = iAdRootDSE.Get("configurationNamingContext") Conn.Provider = "ADsDSOObject" Conn.Open "ADs Provider" serverQuery = "<GC://" & strNameingContext & ">;(&(objectCategory=msExchExchangeServer));name,distinguishedName;subtree" Com.ActiveConnection = Conn Com.Properties("Sort on") = "name" Com.CommandText = serverQuery Set Rs = Com.Execute While Not Rs.EOF output = output & "<font size=2><u><b>" & Rs.Fields("name") & "</b></u></font>" & vbcrlf mbQuery = "<LDAP://" & strNameingContext & ">;(&(objectCategory=msExchPrivateMDB)(legacyExchangeDN=*" & _ Rs.Fields("name") & "/cn=Microsoft Private MDB));name,distinguishedName;subtree" pfQuery = "<LDAP://" & strNameingContext & ">;(&(objectCategory=msExchPublicMDB)(legacyExchangeDN=*" & _ Rs.Fields("name") & "/cn=Microsoft Public MDB));name,distinguishedName;subtree" Com.CommandText = mbQuery Set Rs1 = Com.Execute If Rs1.RecordCount = 0 Then output = output & "<table><tr><td width=50%><font size=2>&nbsp;&nbsp;&nbsp;&nbsp;No mailbox stores." & _ "</font></td></tr>" & vbcrlf Else output = output & "<table>" While Not Rs1.EOF mdbobj.datasource.open "LDAP://" & Rs1.Fields("distinguishedName") output = output & "<tr><td width=50%><font size=2>&nbsp;&nbsp;&nbsp;&nbsp;" & Rs1.Fields("name") & _ " </font></td><td><font size=2>Last Backed Up :" & mdbobj.LastFullBackupTime & "</font></td></tr>" & vbcrlf Rs1.MoveNext Wend End If Rs1.Close Com.CommandText = pfQuery Set Rs2 = Com.Execute If Rs2.RecordCount = 0 Then output = output & "<tr><td width=50%><font size=2>&nbsp;&nbsp;&nbsp;&nbsp;No public folder store.</td></tr>" & vbcrlf Else pdbobj.datasource.open "LDAP://" & Rs2.Fields("distinguishedName") output = output & "<tr><td width=50%><font size=2>&nbsp;&nbsp;&nbsp;&nbsp;" & _ Rs2.Fields("name") & " </font></td><td><font size=2>Last Backed Up :" & _ pdbobj.LastFullBackupTime & "</font></td></tr>" & vbcrlf End If output = output & "</table>" Rs2.Close On Error Goto 0 output = output & vbcrlf Rs.MoveNext Wend Set iMsg = CreateObject("CDO.Message") With iMsg .To = strSMTPRecipient .From = strSMTPSender .Subject = "Last Exchange Backup Report" .HTMLBody = output .Configuration.Fields.Item("<a href="http://schemas.microsoft.com/cdo/configuration/sendusing">http://schemas.microsoft.com/cdo/configuration/sendusing</a>") = 2 .Configuration.Fields.Item("<a href="http://schemas.microsoft.com/cdo/configuration/smtpserver">http://schemas.microsoft.com/cdo/configuration/smtpserver</a>") = strSMTPServer .Configuration.Fields.Item("<a href="http://schemas.microsoft.com/cdo/configuration/smtpserverport">http://schemas.microsoft.com/cdo/configuration/smtpserverport</a>") = 25 .Configuration.Fields.Update .Send End With Rs.Close Conn.Close set mdbobj = Nothing set pdbobj = Nothing Set Rs = Nothing Set Rs1 = Nothing Set Rs2 = Nothing Set Com = Nothing Set Conn = Nothing |
Send email notification for password expiration to “remote” users
Over on Michael Smith’s blog, he has a script to notify users when their password is about to expire. This is handy for Exchange users who never log in to the network because they are offsite or on an extranet (i.e., POP3/IMAP4/RPC-HTTP users). It will crawl an OU and check the days until expiration and, if less than a variable you set, send an email via CDO.
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.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 |
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 ("<a href="http://schemas.microsoft.com/cdo/configuration/sendusing">http://schemas.microsoft.com/cdo/configuration/sendusing</a>") = 2 objMail.Configuration.Fields.Item ("<a href="http://schemas.microsoft.com/cdo/configuration/smtpserver">http://schemas.microsoft.com/cdo/configuration/smtpserver</a>") = SMTP_SERVER objMail.Configuration.Fields.Item ("<a href="http://schemas.microsoft.com/cdo/configuration/smtpserverport">http://schemas.microsoft.com/cdo/configuration/smtpserverport</a>") = 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 (<a href="https://www.company.com">https://www.company.com</a>) 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 |
Find (and delete) orphaned delegate rules
When a user adds someone as a delegate of his/her mailbox and selects the option to have meeting requests go to the delegate, a hidden rule is created in the Inbox of the delegator. When you remove the delegate from the list the rule is deleted. But if the delegate isn’t removed before the delegee’s mailbox is deleted (presumably due to termination), the rule isn’t deleted. The delegate is removed from the Delegates tab so you can’t remove the rule, effectively orphaning the rule. Because the rule still exists, meeting requests will still be sent to the delegate. Since the mailbox doesn’t exist anymore, the meeting requestor will receive an NDR from a person they didn’t even invite to the meeting.
Microsoft’s solution is to use MDBView and go through the hidden items in the inbox until you find the corresponding rule and manually delete it. You can also use the better tool, MFCMapi, to do it. I wanted a better way to do it, and one that admins who don’t delve into raw MAPI viewers could use. So I wrote this WebDAV script that queries the target mailbox for the hidden items in the inbox, displays them in a table, and allows you No. to delete the message from the results window.
The delegate rule’s Rule Provider Content value is “Schedule+ EMS Interface.” If the delegator has multiple delegates who receive meeting requests (not that common) you won’t see multiple rules. There is only one rule, regardless of the number of recipients. If you don’t see an item with the Rule Provider Content Value above, then the user doesn’t have any delegates who receive meeting requests.
The script uses Exchange 2003 SP1’s ability to use the SMTP address in the URL, negating the need for a virtual directory for each SMTP namespace in your org. So you need SP1 for this to function. Just change the values near the top for the protocol and server name of your front-end or back-end server. I wrapped the script in a web page so it can be hosted on an IIS server and then you can just browse to it from anywhere. Note that it is not a server-side script. The code will be executed by the client and will prompt for credentials. Putting it in a web page is just a convenience. Just copy and paste it into a file, or download it here.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 |
<html> <head> <script language='VBScript'> Dim objXMLHTTP, objXMLDoc ' Define your protocol; http or https strProtocol = "http" ' Define your server name strServername = "[server]" ' Define your local name for 'Inbox' strInbox = "Inbox" Sub getMessages_OnClick() strUsername = document.all.mailbox.value If strUsername <> "" Then strInboxURL = strProtocol & "://" & strServername & "/Exchange/" strInboxURL = strInboxURL & strUsername & "/" & strInbox Set objXMLHTTP = CreateObject("Microsoft.XMLHTTP") objXMLHTTP.Open "SEARCH", strInboxURL, True objXMLHTTP.setRequestHeader "Content-type:", "text/xml" objXMLHTTP.setRequestHeader "Depth", "1" objXMLHTTP.onReadyStateChange = getRef("checkXMLHTTPState") strXML = "<?xml version='1.0' ?>" & _ "<a:searchrequest xmlns:a='DAV:'><a:sql>" & _ "SELECT" & _ " ""DAV:displayname""" & _ ",""<a href="http://schemas.microsoft.com/mapi/proptag/x65eb001f">http://schemas.microsoft.com/mapi/proptag/x65eb001f</a>""" & _ " FROM scope('shallow traversal of """ & strInboxURL & """')" & _ " WHERE ""DAV:ishidden""=True" & _ " AND ""DAV:isfolder""=False" & _ "</a:sql></a:searchrequest>" objXMLHTTP.Send(strXML) End If End Sub Sub checkXMLHTTPState If objXMLHTTP.readyState = 4 Then ResponseStatus.innerHTML = "Server Response: " & objXMLHTTP.Status & " - " & objXMLHTTP.StatusText Set objXMLDoc = objXMLHTTP.ResponseXML XSLDiv.innerHTML = objXMLDoc.TransformNode(responseXSL.documentElement) Set objXMLHTTP = Nothing Set objXMLDoc = Nothing End If End Sub Function deleteMessage(strURL) strUsername = document.all.mailbox.value strInboxURL = strProtocol & "://" & strServername & "/Exchange/" strInboxURL = strInboxURL & strUsername & "/" & strInbox strItemURL = strInboxURL & "/" & Replace(strURL, chr(34), "") Set objDelete = CreateObject("Microsoft.XMLHTTP") objDelete.Open "DELETE", strItemURL, False objDelete.Send If (objDelete.Status >=200 And objDelete.Status <300) Then MsgBox "Successful deletion." Else MsgBox "Delete request failed." End If Set objDelete = Nothing Call getMessages_OnClick() End Function </script> <xml id='responseXSL'> <xsl:template xmlns:xsl='uri:xsl' xmlns:a='DAV:' xmlns:d='urn:schemas:httpmail:' xmlns:mapitag='http://schemas.microsoft.com/mapi/proptag/'> <table width='75%' border='1'> <tr> <td align='center'><font size='2'><b>Action</b></font></td> <td width='40%' align='center'><font size='2'><b>Message Subject</b></font></td> <td align='center'><font size='2'><b>Rule Provider Content</b></font></td> </tr> <xsl:for-each select='a:multistatus/a:response'> <tr> <td align='center'> <input> <xsl:attribute name='type'>button</xsl:attribute> <xsl:attribute name='name'>deleteMessage1</xsl:attribute> <xsl:attribute name='value'>Delete</xsl:attribute> <xsl:attribute name='onclick'>vbscript:deleteMessage("<xsl:value-of select='string(a:propstat/a:prop/a:displayname)' />") </xsl:attribute> </input> </td> <td><font size='2'><xsl:value-of select='a:propstat/a:prop/a:displayname' /></font></td> <td><font size='2'><xsl:value-of select='a:propstat/a:prop/mapitag:x65eb001f' /></font></td> </tr> </xsl:for-each> </table> </xsl:template> </xml> </head> <body> <font face='Verdana' size='2'>SMTP Address:<br> <input type='text' name='mailbox'><br> <input type='button' name='getMessages' value='Retrieve'><br><br> <div id='responseStatus'></div> <div id='XSLDiv'></div> </body> </html> |