asked on

Need to create a company phone listing from our Active Directory

Hello,

I have been tasked with creating a company phone listing and pulling the data for the phone list from our Active Directory. Our Active Directory as set up by our Network Admin includes and is updated with Phone Extension and Name of the individual. So as the data is there I just need to run the script each week to get an updated Name, phone listing to post on our intranet site.

All we need is Name and Phone Ext. (sorting by First Name, Last Name and then a seperate listing by Last Name, First Name)
Ideally I would like a script that will pull the data from Active Directory and post it into an Excel spreadsheet to run each week as I run the script. I suppose I could run it through Excell as a VBA script, but I am not sure how to link to the AD and pull the data I need out of it.

I do know the we also run Miscrosoft Exchange Server 2003 and when I open Outlook 2003 I see that there is a Address book with a Global Address Listing which has all the info as well. Maybe there is a way to pull the data from there and export/format it for Excel?

Any help appreciated!

Leo Eikelman

Here is some simple starter code to show you how to connect to AD and get data

Dim oRootDSE, oConnection, oCommand, oRecordSet, userName

' Establishes a connection to rootDSE
Set oRootDSE = GetObject("LDAP://rootDSE")

Set oConnection = CreateObject("ADODB.Connection")

oConnection.Open "Provider=ADsDSOObject;"
Set oCommand = CreateObject("ADODB.Command")
oCommand.ActiveConnection = oConnection

' This is the filter to do the searching. sn and telephoneNumber are the two variables that it is looking for for EVERY
' Person in AD
' To look for a specific person change samAccountName="*" to the filter of your choice
oCommand.CommandText = "<LDAP://" & oRootDSE.get("defaultNamingContext") & _
">;(&(objectCategory=User)(samAccountName="*"));sn,telephoneNumber;subtree"
Set oRecordSet = oCommand.Execute

On Error Resume Next
' This is how u can get the variables
Email = oRecordSet.Fields("sn")
TelephoneExt = oRecordSet.Fields("telephoneNumber")

oConnection.Close

this is just a beggining code you can use.

Hope it helps,

Leo

PaulyWolly

ASKER

Im sorry but I am not a VB coder.

Can I run this through Excel and in VBA... as a VBA script? Ideally I would like to be able to create this output in an Excel spreadsheet.

Leo Eikelman

Here's an example of using a script to query active directory and store information in excel

Const ADS_SCOPE_SUBTREE = 2
Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.Cells(1, 1).Value = "Last name"
objExcel.Cells(1, 2).Value = "First name"
objExcel.Cells(1, 3).Value = "Department"
objExcel.Cells(1, 4).Value = "Phone number"
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") = 100
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.CommandText = _
"SELECT givenName, SN, department, telephoneNumber FROM " _
& "'LDAP://dc=fabrikam,dc=microsoft,dc=com' WHERE " _
& "objectCategory='user'"
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst
x = 2
Do Until objRecordSet.EOF
objExcel.Cells(x, 1).Value = _
objRecordSet.Fields("SN").Value
objExcel.Cells(x, 2).Value = _
objRecordSet.Fields("givenName").Value
objExcel.Cells(x, 3).Value = _
objRecordSet.Fields("department").Value
objExcel.Cells(x, 4).Value = _
objRecordSet.Fields("telephoneNumber").Value
x = x + 1
objRecordSet.MoveNext
Loop
Set objRange = objExcel.Range("A1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("B1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("C1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("D1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.Autofit()
Set objRange = objExcel.Range("A1").SpecialCells(11)
Set objRange2 = objExcel.Range("C1")
Set objRange3 = objExcel.Range("A1")
objRange.Sort objRange2,,objRange3,,,,,1

Use it as a starting block

You can find more information here
http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnclinic/html/scripting05112004.asp

Hope that helps,

Leo

PaulyWolly

ASKER

Leo,

Thanks for the code... it looks like this will work to a point. When I run it I get an error: "Compile Error: Syntax Error" and the debugger points to the line: "objRange.AutoFit()"

If I comment out all the lines for objRange.AutoFit() calls then the script runs but the data is not formatted. I am using Excell 2003

Any ideas?

Leo Eikelman

hmmmmmm.

I found this code.

With XL.Workbooks.Open(strFileSpec)
.Sheets(1).Rows(1).Font.Color = RGB(0,0,128)
.Sheets(1).Rows(1).Font.Bold = True
.Sheets(1).Columns.AutoFit
.Sheets(1).PageSetup.PrintTitleRows = "$1:$1"
.Windows(1).DisplayGridlines = False
.Windows(1).SplitRow = 1
.Windows(1).FreezePanes = True
.Saved = True
End With

OR

obj.Cells.Select
obj.Cells.EntireColumn.AutoFit

This seems like it is doing some formatting.

I don't know if u can do

objRange.Cells.Select
objRange.Cells.EntireColumn.Autofit()

Not too familiar with formatting.

Leo

PaulyWolly

ASKER

I pieced together this code and it works well. Problem is I need to filter the results based on a specific attribute in Active Directory called "msExchHideFromAddressLists". Since we use Active Directory and MS Exchange 2003, my admin sets a marker in AD that HIDES the entries from the Global Address List if this is made to be TRUE. Any ideas on how I would add code to the script so that output will show me ONLY results that have the attribute.msExchHideFromAddressLists = FALSE. I am not sure how to add a IF - Then - Else - End If statement for this.

--------------------------------------------

Sub pull_list_from_ad()

Const ADS_SCOPE_SUBTREE = 2

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = True

'Create a workbook
objExcel.Workbooks.Add

'Create column headers with Column names
objExcel.Cells(1, 1).Value = "Last name"
objExcel.Cells(1, 1).Font.Bold = True

objExcel.Cells(1, 2).Value = "First name"
objExcel.Cells(1, 2).Font.Bold = True

objExcel.Cells(1, 3).Value = "Department"
objExcel.Cells(1, 3).Font.Bold = True

objExcel.Cells(1, 4).Value = "Phone number"
objExcel.Cells(1, 4).Font.Bold = True

objExcel.Cells(1, 5).Value = "Mobile number"
objExcel.Cells(1, 5).Font.Bold = True

'Create connection to data set
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") = 100
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE

'Open database and query dataset
objCommand.CommandText = _
"SELECT givenName, SN, department, telephoneNumber, mobile FROM " _
& "'LDAP://dc=fabrikam,dc=microsoft,dc=com' WHERE " _
& "objectCategory='user'"
Set objRecordSet = objCommand.Execute

'Populate recordset
objRecordSet.MoveFirst
x = 3

Do Until objRecordSet.EOF
objExcel.Cells(x, 1).Value = _
objRecordSet.Fields("SN").Value
objExcel.Cells(x, 2).Value = _
objRecordSet.Fields("givenName").Value
objExcel.Cells(x, 3).Value = _
objRecordSet.Fields("department").Value
objExcel.Cells(x, 4).Value = _
objRecordSet.Fields("telephoneNumber").Value
objExcel.Cells(x, 5).Value = _
objRecordSet.Fields("mobile").Value
x = x + 1
objRecordSet.MoveNext
Loop

'Set formatting for each column
Set objRange = objExcel.Range("A1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit

Set objRange = objExcel.Range("B1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit

Set objRange = objExcel.Range("C1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit

Set objRange = objExcel.Range("D1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit

Set objRange = objExcel.Range("E1")
objRange.Activate
Set objRange = objExcel.ActiveCell.EntireColumn
objRange.AutoFit

Set objRange = objExcel.Range("A1").SpecialCells(11)
Set objRange2 = objExcel.Range("A1")

'Set the ranges so that we can sort
Set objRange = objExcel.Range("A:E")
Set objRange2 = objExcel.Range("A1")

'Sort
objRange.Sort objRange2, 1, , , , , , 1

'Create constants for saving local file output
Const strFileName = ("c:\inetpub\wwwroot\AD_phonelist\AD_phonelist.xls")
Set objWorkbook = objExcel.ActiveWorkbook

'Need to delete existing file if found
'Loop through all the files in the directory by using Dir$ function
Dim MyFile As String
MyFile = Dir$("c:\inetpub\wwwroot\AD_phonelist\*.*")
Do While MyFile <> ""
Kill "c:\inetpub\wwwroot\AD_phonelist\" & MyFile
'need to specify full path again because a file was deleted 1
MyFile = Dir$("c:\inetpub\wwwroot\AD_phonelist\AD_phonelist\*.*")
Loop

'Save output as a local file
objWorkbook.SaveAs strFileName

End Sub

ASKER CERTIFIED SOLUTION

Leo Eikelman

membership

Create a free account to see this answer

Signing up is free and takes 30 seconds. No credit card required.

See answer

PaulyWolly

ASKER

I added the code above and the script does nothing. there is no output except the column headings. I am not even generating any data now.

PaulyWolly

ASKER

Leo,

Thanks I got it to work after I removed the "" around FALSE. I still am finding some unwanted results coming through and I would like to filter them as well. I am finding I have to do this:

Do Until objRecordSet.EOF
If (objRecordSet.Fields("msExchHideFromAddressLists").Value = True) Or _
(objRecordSet.Fields("givenName").Value = "Conf") Or (objRecordSet.Fields("givenName").Value = "Test") Or _
(objRecordSet.Fields("givenName").Value = "DHCP") Or (objRecordSet.Fields("department").Value = BLANK) Or _
(objRecordSet.Fields("givenName").Value = "Product") Or (objRecordSet.Fields("givenName").Value = "(null)") Or _
(objRecordSet.Fields("givenName").Value = "") Then
x = x + 1
Else
objExcel.Cells(x, 1).Value = _
objRecordSet.Fields("SN").Value
objExcel.Cells(x, 2).Value = _
objRecordSet.Fields("givenName").Value
objExcel.Cells(x, 3).Value = _
objRecordSet.Fields("department").Value
objExcel.Cells(x, 4).Value = _
objRecordSet.Fields("telephoneNumber").Value
objExcel.Cells(x, 5).Value = _
objRecordSet.Fields("mobile").Value
x = x + 1
End If
objRecordSet.MoveNext

Loop

If you know of a cleaner way to code this then I would be appreciative.

PaulyWolly

ASKER

I thought I could filter on a field that was with no value by using (objRecordSet.Fields("department").Value = BLANK) or (objRecordSet.Fields("department").Value = "") for field that are not showing a value, but this does not seem to be working.

Leo Eikelman

have u tried = NULL ?

Leo