We help IT Professionals succeed at work.

We've partnered with Certified Experts, Carl Webster and Richard Faulkner, to bring you a podcast all about Citrix Workspace, moving to the cloud, and analytics & intelligence. Episode 2 coming soon!Listen Now

x

Need to create a company phone listing from our Active Directory

PaulyWolly
PaulyWolly asked
on
Medium Priority
243 Views
Last Modified: 2010-05-01
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!
Comment
Watch Question

Leo EikelmanDirector, IT and Business Development

Commented:
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

Author

Commented:
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 EikelmanDirector, IT and Business Development

Commented:
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

Author

Commented:
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 EikelmanDirector, IT and Business Development

Commented:
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

Author

Commented:
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
Director, IT and Business Development
Commented:
so if each object has the msExchHideFromAddressLists attribute then you can add it in your select statement:

 objCommand.CommandText = _
        "SELECT givenName, SN, department, telephoneNumber, mobile , msExchHideFromAddressLists  FROM " _
            & "'LDAP://dc=fabrikam,dc=microsoft,dc=com' WHERE " _
            & "objectCategory='user'"

And then when you are getting the values you can add an iff statement to check:

Do Until objRecordSet.EOF
  if  objRecordSet.Fields("msExchHideFromAddressLists").Value = "FALSE" then
        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


cheers,

Leo

Not the solution you were looking for? Getting a personalized solution is easy.

Ask the Experts

Author

Commented:
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.

Author

Commented:
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.

Author

Commented:
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 EikelmanDirector, IT and Business Development

Commented:
have u tried = NULL  ?

Leo
Access more of Experts Exchange with a free account
Thanks for using Experts Exchange.

Create a free account to continue.

Limited access with a free account allows you to:

  • View three pieces of content (articles, solutions, posts, and videos)
  • Ask the experts questions (counted toward content limit)
  • Customize your dashboard and profile

*This site is protected by reCAPTCHA and the Google Privacy Policy and Terms of Service apply.

OR

Please enter a first name

Please enter a last name

8+ characters (letters, numbers, and a symbol)

By clicking, you agree to the Terms of Use and Privacy Policy.