How get user's EAS statistics in Exchange 2003?

Spanish Version

Good morning,

My friends the below script pulls the info about the user's devices statistics (EAS) in your Exchange 2003 organization. The result is stored in an Excel spreadsheet and it is posted in a Sharepoint  site. The way to access this data in  mailbox's hidden folder is webDAV

The code:

####### BEGGINING   #################################################

On Error Resume Next
Dim connLDAP
Dim objCOM
Dim rsLDAP
Dim StrSQL
Dim correo
Dim salida,handle,arr(10)
Dim filtro,furl,serverEx,strname,serachAsync2
c=0
t=0
Set ConnLDAP = CreateObject("ADODB.connection")
Set objCOM = CreateObject("ADODB.Command")
connLDAP.Provider = "ADsDSOObject"
connLDAP.Open
   
objCOM.ActiveConnection = connLDAP
objCOM.Properties("searchscope") = 2
objCOM.Properties("Chase referrals") = 64
objCOM.Properties("Cache Results") = False

StrSQL = "SELECT name,distinguishedName FROM 'LDAP://DC=us,DC=contoso,DC=com' where  objectCategory='organizationalUnit' "
wscript.echo "Handle,EAS-Status,Sync-Activated,Device-name,DeviceID,Last-Folder-Sync,Last-update,Exchange-Server,Region"
objCOM.CommandText = StrSQL
Set rsLDAP = objCOM.Execute
While Not rsLDAP.EOF
filtro = "LDAP://" & rsLDAP(0)
if instr(filtro,"OU=All Users ") <> 0  then

Set objUsers = GetObject(filtro)
For Each objUser In objUsers
 if objUser.class="user" then
            strname = objUser.Get("name")
     handle=objUser.Get("samAccountName")
     strWirelessEnabled = objUser.Get("msExchOmaAdminWirelessEnable")
            oRegion=objUser.Get("region")
     strHomeMDB= split(objUser.get("homeMDB"),",")
     if err.number <> 0 then
  err.clear
  noEx=true
     else
  noEx=false
     end if
     if noEx=false then
   if instr(strHomeMDB(0),"MBX") <> 0 then ' -> this filter exchange 2007 user   else
    serverEx=right(trim(replace(replace(strHomeMDB(0),")",""),"(","")),11)
    if instr(strHomeMDB(0), "Server_name") = 0 then
     serverEx=right(trim(replace(replace(strHomeMDB(0),")",""),"(","")),11)
    else
     serverEx=right(trim(replace(replace(strHomeMDB(0),")",""),"(","")),9)
    end if
    t=t+1
    if strWirelessEnabled = 0 then

     furl ="http://" & serverEx & "/exchange/" & handle & "/NON_IPM_SUBTREE/"
     set req = createobject("microsoft.xmlhttp")
     'WScript.Echo handle & ",Enabled," & SerachAsync(furl) & "," & serverEx
     call SerachAsync(furl)
     if serachAsync2 = "YES" then
      WScript.Echo handle & ",Enabled," & SerachAsync2 & "," & arr(1) & "," & serverEx & "," & oRegion
     else
      WScript.Echo handle & ",Enabled," & SerachAsync2 & "," & "N/A,N/A,N/A,N/A," & serverEx & "," & oRegion
     end if
    c=c+1

    end if
          end if
     end if
 end if             
Next
end if
rsLDAP.MoveNext

Wend


const xlnormal=&HFFFFEFD1
dim appExcel
fecha=replace(date,"/","")
pathFile="d:\reportes\"
file="EASUserReport" & fecha & ".xls"
fileCSV="EASUserReport.csv"

Set appexcel= createObject("Excel.application")
appExcel.workbooks.open pathFile + fileCSV
appexcel.ActiveWorkbook.SaveAs pathFile + file ,xlNormal
appExcel.Workbooks.close
appexcel.quit


const adTypeBinary = 1
const adModeWrite = 2
const adModeReadWrite = 3
user="dominio\user"
pass="Password"
const adCreateOverwrite = &H4000000

dim objStream, objRecord
dim strUrl
strUrl = "http://sharepoint.contoso.com/Report/Shared%20Documents/EAS%20Reports/"
set objRecord = CreateObject("ADODB.Record")
set objStream = CreateObject("ADODB.Stream")

objRecord.Open strUrl + File,"", adModeReadWrite, adCreateOverwrite,,user,pass
objStream.Type = adTypeBinary
objStream.Open  "URL=" + strUrl + File, adModeWrite
objStream.LoadFromFile  File
objStream.Close
objRecord.Close

set objStream = nothing
set objRecord = nothing







sub SerachAsync(furl)

strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"" >"
strQuery = strQuery & "<D:sql>SELECT""http://schemas.microsoft.com/mapi/proptag/x3001001E"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & furl & """') Where ""DAV:ishidden"" = False AND ""DAV:isfolder"" = True AND "
strQuery = strQuery & """http://schemas.microsoft.com/mapi/proptag/x3001001E"" = 'Microsoft-Server-ActiveSync'</D:sql></D:searchrequest>"
req.open "SEARCH", furl, false,"domain\user","Password"
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
on error resume next
req.send strQuery
if err.number <> 0 then wscript.echo err.description
on error goto 0
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("d:x3001001E")
if oNodeList.length <> 0 then

 SerachAsync2="YES"
 call displayAyncSub(furl & "/Microsoft-Server-ActiveSync")

else
 SerachAsync2="NO"
end if

end if
'exit
end sub

sub displayAyncSub(furl)
strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"" >"
strQuery = strQuery & "<D:sql>SELECT ""http://schemas.microsoft.com/mapi/proptag/x3001001E"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & furl & """') Where ""DAV:ishidden"" = False AND ""DAV:isfolder"" = True</D:sql></D:searchrequest>"
req.open "SEARCH", furl, false,"domain\user","Password"
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
on error resume next
req.send strQuery
if err.number <> 0 then wscript.echo err.description
on error goto 0
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("d:x3001001E")
for each node in oNodeList
'wscript.echo node.text
call displaydeviceSub(furl & "/" & node.text,node.text)
next
Else
End If
end sub



sub displaydeviceSub(furl,fname)
strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"" >"
strQuery = strQuery & "<D:sql>SELECT ""http://schemas.microsoft.com/mapi/proptag/x3001001E"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & furl & """') Where ""DAV:ishidden"" = False AND ""DAV:isfolder"" = True</D:sql></D:searchrequest>"
req.open "SEARCH", furl, false,"domain\user","Password"
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
on error resume next
req.send strQuery
if err.number <> 0 then wscript.echo err.description
on error goto 0
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("d:x3001001E")
report=""
for each node in oNodeList
'if instr(fname,"IMEI") = 0 then
k=k+1
report= fname & "," & node.text & "," & finditems(furl & "/" & node.text)
arr(k)=report
'wscript.echo arr(k)
'end if
next

Else
End If

end sub


function finditems(furl)
hascalsyc = 0
hasfolsyc = 0
hasconsyc = 0
hasautd = 0
rback = ""
strQuery = "<?xml version=""1.0""?><D:searchrequest xmlns:D = ""DAV:"" >"
strQuery = strQuery & "<D:sql>SELECT ""DAV:displayname"",""DAV:getlastmodified"""
strQuery = strQuery & " FROM scope('shallow traversal of """
strQuery = strQuery & furl & """') Where ""DAV:isfolder"" = False</D:sql></D:searchrequest>"
req.open "SEARCH", furl, false,"domain\user","Password"
req.setrequestheader "Content-Type", "text/xml"
req.setRequestHeader "Translate","f"
on error resume next
req.send strQuery
if err.number <> 0 then wscript.echo err.description
on error goto 0
rem response.write req.responsetext
If req.status >= 500 Then
ElseIf req.status = 207 Then
set oResponseDoc = req.responseXML
set oNodeList = oResponseDoc.getElementsByTagName("a:displayname")
set oNodemodlist = oResponseDoc.getElementsByTagName("a:getlastmodified")
'response.write oNodeList.length
for i = 1 to oNodeList.length
set onode = oNodeList.nextNode
Set onode1 = oNodemodlist.nextNode
select case lcase(onode.text)
case "calendarsyncfile" hascalsyc = 1
hascalsycval = DateAdd("h",toffset,(left(replace(replace(onode1.text,"T"," "),"Z",""),19)))
case "foldersyncfile" hasfolsyc = 1
hasfolsycval = DateAdd("h",toffset,(left(replace(replace(onode1.text,"T"," "),"Z",""),19)))
case "contactssyncfile" hasconsyc = 1
hasconsycval = DateAdd("h",toffset,(left(replace(replace(onode1.text,"T"," "),"Z",""),19)))
case "autdstate.xml" hasautd = 1
hasautdval = DateAdd("h",toffset,(left(replace(replace(onode1.text,"T"," "),"Z",""),19)))
end select
next
Else
End If
if hasfolsyc = 1 then
rback = rback & hasfolsycval & ","
else
rback = rback & "No,"
end if
if hasautd <> 0 then
rback = rback & hasautdval
else
rback = rback & "No"
end if
finditems = rback
end function

#######END OF SCRIPT########################################################

Enjoy! Please let me your comments,,

-Dario