' Checking for Do Not Archive flag ' A short script by Rob Wilcox ' ' 30th September 2012 ' Version 1.0 if wscript.arguments.count = 0 then wscript.echo "Could not run." wscript.echo "Specify the netbios name of an Exchange server on the command line" wscript.quit(-1) end if servername = wscript.arguments(0) debugon=true ' setup output file if wscript.arguments.count = 2 then filename = wscript.arguments(1) else filename = "checkdonotarchive.log" ' default name/location end if Set objFSO = CreateObject("Scripting.FileSystemObject") set fscon = objfso.CreateTextFile(filename) set conn = createobject("ADODB.Connection") set com = createobject("ADODB.Command") Set iAdRootDSE = GetObject("LDAP://RootDSE") strNameingContext = iAdRootDSE.Get("configurationNamingContext") strDefaultNamingContext = iAdRootDSE.Get("defaultNamingContext") Conn.Provider = "ADsDSOObject" Conn.Open "ADs Provider" svcQuery = ";(&(objectCategory=msExchExchangeServer)(cn=" & Servername & "));cn,name,legacyExchangeDN;subtree" Com.ActiveConnection = Conn Com.CommandText = svcQuery Set Rs = Com.Execute ' Write out header info to file fscon.writeline "Starting to process mailboxes on " & servername fscon.writeline "Processing started at " & date() & " " & time() while not rs.eof GALQueryFilter = "(&(&(&(& (mailnickname=*)(!msExchHideFromAddressLists=TRUE)(|(&(objectCategory=person)(objectClass=user)(msExchHomeServerName=" & rs.fields("legacyExchangeDN") & ")) )))))" strQuery = ";" & GALQueryFilter & ";distinguishedName,mail,mailnickname;subtree" com.Properties("Page Size") = 100 Com.CommandText = strQuery Set Rs1 = Com.Execute while not Rs1.eof fscon.Writeline "Checking Mailbox: " & rs1.fields("mailnickname") wscript.echo "Checking Mailbox: " & rs1.fields("mailnickname") call checkmbx(servername,rs1.fields("mailnickname")) rs1.movenext wend rs.movenext wend rs.close set conn = nothing set com = nothing ' Closing file fscon.writeline "Processing finished at " & date() & " " & time() fscon.close function checkmbx(servername, mailboxname) Set objSession = CreateObject("MAPI.Session") objSession.Logon "","",false,true,true,true,servername & vbLF & mailboxname Set CdoInfoStore = objSession.GetInfoStore Set CdoFolderRoot = CdoInfoStore.RootFolder ' Start at the very top of the information store t = checkfolder(CDOFolderRoot, objSession, 1) ' Clean up objects Set CDOFolder = Nothing ' Logoff the CDO (1.2, 1.21) session objSession.Logoff Set objSession = Nothing end function function checkfolder(folder, objsession, depth) ' Output the name of the folder padding = "" for i = 1 to depth padding = padding + " " next outstring = padding + " Processing folder: " & folder.Name if debugon then wscript.echo outstring end if ' Look for count of hidden messages NumHiddenMessages = 0 NumHiddenMessages = folder.HiddenMessages.Count if debugon = true and NumHiddenMessages > 0 then wscript.echo padding & " Found " & NumHiddenMessages & " hidden messages" end if ' Process each hidden message founddonotarchiveflag = false for each xmsg in folder.HiddenMessages t = CheckMsg(xmsg, founddonotarchiveflag) next if founddonotarchiveflag = true then if debugon = true then wscript.echo padding & " ** Found Do Not Archive Flag on folder: " & folder.name end if fscon.writeline " ** Found Do Not Archive Flag on folder: " & folder.name end if if folder.folders.count > 0 then depth = depth + 1 for each xfolder in folder.folders t = checkfolder(xfolder, objSession, depth) next depth = depth - 1 end if end function function checkMsg(msg, found) for each f in msg.fields if f.name = "Filter ID" then if f.value = 2 then found = true end if end if next end function