Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Need to create a company phone listing from our Active Directory

Posted on 2006-03-22
11
Medium Priority
?
224 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!
0
Comment
Question by:PaulyWolly
  • 6
  • 5
11 Comments
 
LVL 8

Expert Comment

by:Leo Eikelman
ID: 16274800
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
 

Author Comment

by:PaulyWolly
ID: 16285745
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
 
LVL 8

Expert Comment

by:Leo Eikelman
ID: 16288524
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
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 

Author Comment

by:PaulyWolly
ID: 16294035
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
 
LVL 8

Expert Comment

by:Leo Eikelman
ID: 16294198
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
 

Author Comment

by:PaulyWolly
ID: 16400418
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
 
LVL 8

Accepted Solution

by:
Leo Eikelman earned 600 total points
ID: 16401380
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
 

Author Comment

by:PaulyWolly
ID: 16409811
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
 

Author Comment

by:PaulyWolly
ID: 16409908
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
 

Author Comment

by:PaulyWolly
ID: 16409916
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
 
LVL 8

Expert Comment

by:Leo Eikelman
ID: 16417341
have u tried = NULL  ?

Leo
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

The debugging module of the VB 6 IDE can be accessed by way of the Debug menu item. That menu item can normally be found in the IDE's main menu line as shown in this picture.   There is also a companion Debug Toolbar that looks like the followin…
Enums (shorthand for ‘enumerations’) are not often used by programmers but they can be quite valuable when they are.  What are they? An Enum is just a type of variable like a string or an Integer, but in this case one that you create that contains…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Suggested Courses

578 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question