Get all user names & telephone numbers from active directory and ouput as html with vbscript

I want to use vbscript to get the Display Name, IP Phone and Mobile from active directory users with phone numbers and output it to an html table so basically a phone book.

User properties I need.
objUser.displayName, objUser.ipPhone and objUser.Mobile  

I have tried to modify a few sample scripts but I am unable to get them working. I have included two here; the first one outputs html and sorts aphabetically and the second one outputs to excel.

''''''''''''''''''''''''''''''''''''''''''''''''
'             First code example               '
''''''''''''''''''''''''''''''''''''''''''''''''

'On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2

strExcelPath = "c:\groups\accounts.xls"
	Set objExcel = CreateObject("Excel.Application")
	objExcel.Workbooks.Add
	Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
	objSheet.Name = "Users"
	objSheet.Cells(1, 1).Value = "First Name"
	objSheet.Cells(1, 2).Value = "Telephone Number"
	objSheet.Cells(1, 3).Value = "IP Phone"


Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 

objCommand.CommandText = "SELECT AdsPath FROM 'LDAP://DC=my,DC=domain,DC=com,DC=au' WHERE objectCategory='user' AND telephoneNumber='*'"
	
Set objRecordSet = objCommand.Execute
k = 2
objRecordSet.MoveFirst
Do Until objRecordSet.EOF
    Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
   	objSheet.Cells(k, 1).value = objUser.displayName
	objSheet.Cells(k, 2).value = objUser.telephoneNumber
	objSheet.Cells(k, 3).value = objUser.ipPhone
	k = k + 1
    
    
    objRecordSet.MoveNext
Loop
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close

objExcel.Application.Quit

Set objSheet = Nothing
Set objExcel = Nothing
WScript.Echo "Finished."

''''''''''''''''''''''''''''''''''''''''''''''''
'            Second code example               '
''''''''''''''''''''''''''''''''''''''''''''''''

Dim arrNames()
Dim FileSystem, oFile
intSize = 0

'Set objGroup = GetObject("LDAP://CN=Accountants,OU=Finance,DC=fabrikam,DC=com")
Set objGroup = GetObject("LDAP://CN=Terminal Server Users,CN=Users,DC=my,DC=domain,DC=com,DC=au")
Set FileSystem = WScript.CreateObject("Scripting.FileSystemObject")
Set oFile = FileSystem.CreateTextFile("hey.html", True)

For Each strUser in objGroup.Member
    Set objUser =  GetObject("LDAP://" & strUser)
    ReDim Preserve arrNames(intSize)
    arrNames(intSize) = objUser.CN
    intSize = intSize + 1
Next

For i = (UBound(arrNames) - 1) to 0 Step -1
    For j= 0 to i
        If UCase(arrNames(j)) > UCase(arrNames(j+1)) Then
            strHolder = arrNames(j+1)
            arrNames(j+1) = arrNames(j)
            arrNames(j) = strHolder
        End If
    Next
Next 

For Each strName in arrNames
    'Wscript.Echo strName
	oFile.writeLine strName&"<br>"
Next

Open in new window

LVL 4
bwilks99Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Psy053Commented:
This will search AD for all users, and output the required details to a HTML Table.



I will have a play around and see what else I can get it to do.


Const ADS_SCOPE_SUBTREE = 2
Const ForWriting = 2
strDomain = "Example.Local"
objCSVFile = "C:\Users.html"

Set objFSO = CreateObject("Scripting.FilesystemObject")
set objLogFile = objFSO.OpenTextFile(objCSVFile, ForWriting, True)
 

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCOmmand.ActiveConnection = objConnection

objCommand.CommandText = "Select displayName, ipPhone, Mobile from 'LDAP://" & strDomain & "' " & _ 
"Where objectCategory='person' AND objectClass='user'" 

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

objLogFile.WriteLine ("<table>")

Do Until objRecordSet.EOF
	strDisplayName = objRecordSet.Fields("DisplayName").Value
	striPPh = objRecordSet.Fields("ipPhone").Value
	strMobile = objRecordSet.Fields("mobile").Value

	objLogFile.WriteLine ("<tr>")
	objLogFile.WriteLine ("<td>" & strDisplayName & "</td>")
	objLogFile.WriteLine ("<td>" & striPPh & "</td>")
	objLogFile.WriteLine ("<td>" & strMobile & "</td>")
	objLogFile.WriteLine ("</tr>") 

   	objRecordSet.MoveNext
Loop

objLogFile.WriteLine ("</table>")

objLogFile.Close

Open in new window

Psy053Commented:
To have the data sorted alphabetically based on Display Name, please change lines 18:

From:
"Where objectCategory='person' AND objectClass='user'"

To:
"Where objectCategory='person' AND objectClass='user' ORDER BY displayName ASC"

bwilks99Author Commented:
Hi that looks good thanks. I added telephoneNumber='*' to get only users with telephone numbers.

Line 18 now looks like this;
"Where objectCategory='person' AND objectClass='user' And telephoneNumber='*' ORDER BY displayName ASC"


One last thing I forgot to mention is; how can I get alternate colours on the table rows so it's easy to read?
Psy053Commented:
Here you go:


Const ADS_SCOPE_SUBTREE = 2
Const ForWriting = 2
strDomain = "Example.Local"
objCSVFile = "C:\Users.html"

Set objFSO = CreateObject("Scripting.FilesystemObject")
set objLogFile = objFSO.OpenTextFile(objCSVFile, ForWriting, True)
 

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCOmmand.ActiveConnection = objConnection

objCommand.CommandText = "Select displayName, ipPhone, Mobile from 'LDAP://" & strDomain & "' " & _ 
"Where objectCategory='person' AND objectClass='user' And telephoneNumber='*' ORDER BY displayName ASC"


objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE 
Set objRecordSet = objCommand.Execute
' objRecordSet.Sort = "DisplayName"
objRecordSet.MoveFirst

objLogFile.WriteLine ("<table>")

strBGC="#FFFFFF"

Do Until objRecordSet.EOF
	strDisplayName = objRecordSet.Fields("DisplayName").Value
	striPPh = objRecordSet.Fields("ipPhone").Value
	strMobile = objRecordSet.Fields("mobile").Value

	objLogFile.WriteLine ("<tr bgcolor=" & "" & strBGC & "" & ">")
	objLogFile.WriteLine ("<td>" & strDisplayName & "</td>")
	objLogFile.WriteLine ("<td>" & striPPh & "</td>")
	objLogFile.WriteLine ("<td>" & strMobile & "</td>")
	objLogFile.WriteLine ("</tr>") 

	If strBGC = "#FFFFFF" Then
		strBGC = "#C0C0C0"
	Else
		strBGC = "#FFFFFF"
	End If

   	objRecordSet.MoveNext
Loop

objLogFile.WriteLine ("</table>")

objLogFile.Close

Open in new window

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.