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!
PaulyWollyAsked:
Who is Participating?
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.

Leo EikelmanDirector, IT and Business DevelopmentCommented:
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
0
PaulyWollyAuthor 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.
0
Leo EikelmanDirector, IT and Business DevelopmentCommented:
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
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

PaulyWollyAuthor 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?
0
Leo EikelmanDirector, IT and Business DevelopmentCommented:
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
0
PaulyWollyAuthor 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
0
Leo EikelmanDirector, IT and Business DevelopmentCommented:
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
0

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
PaulyWollyAuthor 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.
0
PaulyWollyAuthor 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.
0
PaulyWollyAuthor 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.
0
Leo EikelmanDirector, IT and Business DevelopmentCommented:
have u tried = NULL  ?

Leo
0
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
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.