Announcement

Collapse
No announcement yet.

Need help to search sub OU

Collapse
X
  • Filter
  • Time
  • Show
Clear All
new posts

  • Need help to search sub OU

    I use the following script to export user information in AD. For some reason the script will not search sub OU's even though I set Const ADS_SCOPE_SUBTREE = 2 in the script.

    Could someone please help me get this script to search through sub OU's?

    ------------
    Moderator edit: Added [Code] tags around the code
    Code:
    Const ADS_SCOPE_SUBTREE = 2 
    Dim oXL,oSheet 
    Dim u, s, ProxyAddressesList,aProxy, intCount 
    Dim c 
    Dim root 
    Dim ou 
    Dim TextXL 
    Dim CRLF 
    dim oArgs 
    Dim MyVar 
    Dim Count, ouCount, LineCount 
    Dim oUser, oContainer 
    Dim mob 
    Dim givenName_and_sn 
    Dim givenName_, sn_, mail_,sAMAccountName_,telephoneNumber_,company_ 
    Dim address_,pobox_,postalCode_,stateProvince_,City_,mailalias_,description_ 
    Dim title_,department_,country_,HomePhone_,pager_,fax_ 
    'Get the command line args 
    Set oArgs=wscript.arguments 
    ouCount=0 
    Count=0 
    MyVar=1 
    root="DC=xxx,DC=local" 
    CRLF = Chr(13) & Chr(10) 
    'Start EXCEL and display it to the user 
    Set oXL = WScript.CreateObject("EXCEL.application") 
    oXL.Visible = True 
    'Open the workbook passed in the command line 
    'oXL.workbooks.open TextXL 
    oXL.Workbooks.Add 
     
    'Activate the Add page 
    'oXL.sheets("Dump").New 
    Set oSheet = oXL.ActiveWorkbook.Worksheets(1) 
    oSheet.Name = "UserInfo" 
     
    'Adjust column width 
    oXL.Columns(1).ColumnWidth=39 
    oXL.Columns.Range("B..C").ColumnWidth=20 
    oXL.Columns(4).ColumnWidth=50 
    oXL.Columns(5).ColumnWidth=16 'SAM Account 
    oXL.Columns.Range("F..G").ColumnWidth=18 'Work phone - Mobile 
    oXL.Columns(8).ColumnWidth=25 'Company 
    oXL.Columns(9).ColumnWidth=30 'Address 
    oXL.Columns(10).ColumnWidth=20 'P.O. Box 
    oXL.Columns(11).ColumnWidth=12 'Postal Code 
    oXL.Columns.Range("L..M").ColumnWidth=20 
    oXL.Columns.Range("N..O").ColumnWidth=50 
    oXL.Columns(16).ColumnWidth=15 ' Title 
    oXL.Columns(17).ColumnWidth=25 'Department 
    oXL.Columns(18).ColumnWidth=8 'Country 
    oXL.Columns.Range("S..U").ColumnWidth=18 
    oXL.Columns(22).ColumnWidth=30 'CN 
    oXL.Columns(23).ColumnWidth=40 'msExchUseOAB 
    oXL.Columns(24).ColumnWidth=40 'msExchQueryBaseDN 
     
    ' Centre/justify headings 
    oXL.Range("A1:U2").Select 
    oXL.Selection.HorizontalAlignment = 3 ' xlCentre 
     
    ' Left headings 
    oXL.Range("A3:U350").Select 
    oXL.Selection.HorizontalAlignment = 2 ' xlLeft 
     
    'oXL.Range("A3:U250").Select 
    oXL.Range("A3:U350").NumberFormat = "@" 'Sets selection to text format 
    'oXL.Selection.CellFormat.NumberFormat = "Text" 
    'Worksheets("Sheet1").Range("A17").NumberFormat = "General" 
     
    With oSheet.Range("A1..Z2").Font 
    .Name = "Arial" 
    .Size = 10 
    .bold = True 
    .underline = True 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .ColorIndex = xlAutomatic 
    End With 
    'Some formatting 
    oSheet.Range("A2").Font.underline=False 
    oSheet.Range("A2").Font.bold=False 
    oSheet.Range("B1:C2").Font.ColorIndex=5 'Blue 
    oSheet.Range("D1:D2").Font.ColorIndex=10 'Green 
    oSheet.Range("E1:E2").Font.ColorIndex=3 'Red 
    oSheet.Range("N1:N2").Font.ColorIndex=10 'Green 
    oSheet.Range("V3:V350").Font.ColorIndex=15 'Grey 
    oSheet.Range("W3:W350").Font.ColorIndex=12 
    oSheet.Range("X3:X350").Font.ColorIndex=13 
     
     
    'ou=dummy,ou=testkunde,ou=customers 
    With oSheet.Range("A3..U250").Font 
    .Name = "Arial" 
    .Size = 10 
    .bold = False 
    .Strikethrough = False 
    .Superscript = False 
    .Subscript = False 
    .OutlineFont = False 
    .Shadow = False 
    .ColorIndex = xlAutomatic 
    End With 
    'Some more formatting 
    oSheet.Range("A3:A350").Font.ColorIndex=15 'Grey 
    'build sheet structure 
    oXL.ActiveSheet.range("A1").Activate 
    oXL.activecell.Value="DS Root" 
    oXL.activecell.offset(0, 1).Value="First Name" 
    oXL.activecell.offset(0, 2).Value="Last Name" 
    oXL.activecell.offset(0, 3).Value="E-mail (reply)" 
    oXL.activecell.offset(0, 4).Value="SAM Account" 
    oXL.activecell.offset(0, 5).Value="Work Phone" 
    oXL.activecell.offset(0, 6).Value="Mobile" 
    oXL.activecell.offset(0, 7).Value="Company" 
    oXL.activecell.offset(0, 8).Value="Address" 
    oXL.activecell.offset(0, 9).Value="P. O. Box" 
    oXL.activecell.offset(0, 10).Value="Postal Code" 
    oXL.activecell.offset(0, 11).Value="State/Province" 'State/Province 
    oXL.activecell.offset(0, 12).Value="City" 'city 
    oXL.activecell.offset(0, 13).Value="Mail alias" 'mail alias 
    oXL.activecell.offset(0, 14).Value="Description" 
    oXL.activecell.offset(0, 15).Value="Title" 
    oXL.activecell.offset(0, 16).Value="Department" 
    oXL.activecell.offset(0, 17).Value="Country" 'Country 
    oXL.activecell.offset(0, 18).Value="Home Phone" 
    oXL.activecell.offset(0, 19).Value="Fax" ' FAX 
    oXL.activecell.offset(0, 20).Value="Pager" 
    oXL.activecell.offset(0, 21).Value="Common Name (CN)" 
    oXL.activecell.offset(0, 22).Value="msExchUseOAB" 'DN of OAL in use by this user 
    oXL.activecell.offset(0, 23).Value="msExchQueryBaseDN" 'DN of Address list or OU to use for search in OWA 
     
    'Put the cursor in the starting cell and read the DS root 
    oXL.ActiveSheet.range("A2").Activate ' this cell has the DS root in it 
    'Show it to the user 
    'WScript.Echo oXL.activecell.Value 
    'This is the starting point in the ds 
    oXL.activecell.Value=root 
    'root = oXL.activecell.Value 
     
    'Step to the next row 
    oXL.activecell.offset(1, 0).Activate 
     
    'User input of OU 
    ou = InputBox("Enter OU(s)" & vbcrlf & "Examples:" & vbcrlf & "ou=users" & vbcrlf & "ou=users,ou=leading,ou=noname", "Dump Cust Users - OU info", "ou=users") 
    ' Evaluate the user input. 
    If ou = "" Then ' Cancelled by the user 
    WScript.quit 
    End If 
     
    'Compose the ADSI path... 
    s = ou + "," + root 
     
    'Show it to the user... 
    'WScript.Echo s 
     
    'And get the objects 
    Set oContainer = GetObject("LDAP://" & s) 
    DumpInfo oContainer 
    Sub DumpInfo(oObject) 
    oObject.Filter = Array("user") 
    For Each oUser in oObject 
    oUser.GetInfo 
    ' Start to count 
    Count=Count + 1 
    'ou=dummy,ou=testkunde,ou=customers 
    oXL.activecell.Value=ou 
    On Error Resume Next 
    'Fill Excel with info from AD 
     
    oXL.activecell.offset(0, 1).Value=oUser.Get("givenName") 
    oXL.activecell.offset(0, 2).Value=oUser.Get("sn") 
    oXL.activecell.offset(0, 3).Value=oUser.Get("mail") 
    oXL.activecell.offset(0, 4).Value=oUser.Get("sAMAccountName") 
    oXL.activecell.offset(0, 5).Value=oUser.Get("telephoneNumber") 
    oXL.activecell.offset(0, 6).Value=oUser.Get("mobile") 
    oXL.activecell.offset(0, 7).Value=oUser.Get("company") 
    oXL.activecell.offset(0, 8).Value=oUser.Get("streetAddress") 
    oXL.activecell.offset(0, 9).Value=oUser.Get("PostOfficeBox") 
    oXL.activecell.offset(0, 10).Value=oUser.Get("postalCode") 
    oXL.activecell.offset(0, 11).Value=oUser.Get("st") 'State/Province 
    oXL.activecell.offset(0, 12).Value=oUser.Get("l") 'city 
    'Get the e-mail address array 
    aProxy = oUser.ProxyAddresses 
    For intCount = LBound(aProxy) To UBound(aProxy) 
    ProxyAddressesList=ProxyAddressesList & aProxy(intCount) & "," 
    Next 
     
    oXL.activecell.offset(0, 13).Value=ProxyAddressesList 
    ProxyAddressesList="" 
    oXL.activecell.offset(0, 14).Value=oUser.Get("description") 
    oXL.activecell.offset(0, 15).Value=oUser.Get("title") 
    oXL.activecell.offset(0, 16).Value=oUser.Get("department") 
    oXL.activecell.offset(0, 17).Value=oUser.Get("c") 'Country 
    oXL.activecell.offset(0, 18).Value=oUser.Get("homePhone") 
    oXL.activecell.offset(0, 19).Value=oUser.Get("facsimileTelephoneNumber") ' FAX 
    oXL.activecell.offset(0, 20).Value=oUser.Get("pager") 
    oXL.activecell.offset(0, 21).Value=oUser.Get("cn") 
    oXL.activecell.offset(0, 22).Value=oUser.Get("msExchUseOAB") 
    oXL.activecell.offset(0, 23).Value=oUser.Get("msExchQueryBaseDN") 
     
    ' Concactenate into givenName_and_sn for to check for minimum requiered info 
    givenName_and_sn=givenName_ & sn_ 
    ' Used to track line in spreasheet with missing mandatory values 
    LineCount=Count+oucount 
    'Compose the user common name name from first and last names... 
    uname = "CN=" + oXL.activecell.offset(0, 1).Value + " " + oXL.activecell.offset(0, 2).Value 
    ' Step to next row 
    oXL.activecell.offset(1, 0).Activate 
    Next 
    End Sub 
    oXL.activecell.offset(5, 0).Activate 
    oXL.activecell.Value="e_n_d" 
    oXL.activecell.font.ColorIndex=xlAutomatic 
    oXL.activecell.offset(2, 0).Activate 
    oXL.activecell.Value="Blue = At least one of the cells in the two rows must contain a value when creating a new user" 
    oXL.activecell.font.bold=True 
    oXL.activecell.font.ColorIndex=5 'Blue 
    oXL.activecell.offset(1, 0).Activate 
    oXL.activecell.Value="Red = Cell value must be present when creating a new user" 
    oXL.activecell.font.bold=True 
    oXL.activecell.font.ColorIndex=3 'Red 
    oXL.activecell.offset(1, 0).Activate 
    oXL.activecell.Value="Green = Not yet implimented (i.e. column will be ignoreeed)" 
    oXL.activecell.font.bold=True 
    oXL.activecell.font.ColorIndex=10 'Green 
    oXL.activecell.offset(2, 0).Activate 
    oXL.activecell.Value="e_n_d marks the ending of the scripts traversal of the spreadsheet - anything can be written in the rows/columns after the e_n_d statement" 
    oXL.activecell.font.ColorIndex=xlAutomatic 
    oXL.activecell.offset(2, 0).Activate 
    oXL.activecell.Value="Anything can be written in a row from column B and outwards as long as the beginning of the row (cell in column A) is blank" 
    oXL.activecell.font.ColorIndex=xlAutomatic 
    'cleanup 
    Set oContainer = Nothing 
    WScript.Echo "Finished - " & count & " user(s) dumped"& vbcrlf & vbcrlf & "Remember to save the Worksheet!!!" 
    'ou=dummy,ou=testkunde,ou=customers 
    'Done. close excel spreadsheet 
    'oXL.application.quit
    Last edited by Rems; 4th November 2009, 00:02.

  • #2
    Re: Need help to search sub OU

    Are you looking to search within a specific OU, and then all its sub OU's? Or do you want to search the entire domain?

    Also, please add code tags. Thanks.

    Comment


    • #3
      Re: Need help to search sub OU

      Try using this ldap query instead, see highlighted part in blue:

      Code:
      Set oArgs=wscript.arguments
      ouCount=0
      Count=0
      MyVar=1
      CRLF = Chr(13) & Chr(10)
      
      Set oXL = WScript.CreateObject("EXCEL.application")
      oXL.Visible = True
      oXL.Workbooks.Add
      
      Set oSheet = oXL.ActiveWorkbook.Worksheets(1)
      oSheet.Name = "UserInfo"
      
      oXL.Columns(1).ColumnWidth=39
      oXL.Columns.Range("B..C").ColumnWidth=20
      oXL.Columns(4).ColumnWidth=50
      oXL.Columns(5).ColumnWidth=16 'SAM Account
      oXL.Columns.Range("F..G").ColumnWidth=18 'Work phone - Mobile
      oXL.Columns(.ColumnWidth=25 'Company
      oXL.Columns(9).ColumnWidth=30 'Address
      oXL.Columns(10).ColumnWidth=20 'P.O. Box
      oXL.Columns(11).ColumnWidth=12 'Postal Code
      oXL.Columns.Range("L..M").ColumnWidth=20
      oXL.Columns.Range("N..O").ColumnWidth=50
      oXL.Columns(16).ColumnWidth=15 ' Title
      oXL.Columns(17).ColumnWidth=25 'Department
      oXL.Columns(1.ColumnWidth=8 'Country
      oXL.Columns.Range("S..U").ColumnWidth=18
      oXL.Columns(22).ColumnWidth=30 'CN
      oXL.Columns(23).ColumnWidth=40 'msExchUseOAB
      oXL.Columns(24).ColumnWidth=40 'msExchQueryBaseDN
      
      oXL.Range("A1:U2").Select
      oXL.Selection.HorizontalAlignment = 3 ' xlCentre
      oXL.Range("A3:U350").Select
      oXL.Selection.HorizontalAlignment = 2 ' xlLeft
      oXL.Range("A3:U350").NumberFormat = "@" 'Sets selection to text format
      
      With oSheet.Range("A1..Z2").Font
         .Name = "Arial"
         .Size = 10
         .bold = True
         .underline = True
         .Strikethrough = False
         .Superscript = False
         .Subscript = False
         .OutlineFont = False
         .Shadow = False
         .ColorIndex = xlAutomatic
      End With
      
      oSheet.Range("A2").Font.underline=False
      oSheet.Range("A2").Font.bold=False
      oSheet.Range("B1:C2").Font.ColorIndex=5 'Blue
      oSheet.Range("D12").Font.ColorIndex=10 'Green
      oSheet.Range("E1:E2").Font.ColorIndex=3 'Red
      oSheet.Range("N1:N2").Font.ColorIndex=10 'Green
      oSheet.Range("V3:V350").Font.ColorIndex=15 'Grey
      oSheet.Range("W3:W350").Font.ColorIndex=12
      oSheet.Range("X3:X350").Font.ColorIndex=13
      
      With oSheet.Range("A3..U250").Font
         .Name = "Arial"
         .Size = 10
         .bold = False
         .Strikethrough = False
         .Superscript = False
         .Subscript = False
         .OutlineFont = False
         .Shadow = False
         .ColorIndex = xlAutomatic
      End With
      
      oSheet.Range("A3:A350").Font.ColorIndex=15 'Grey
      
      oXL.ActiveSheet.range("A1").Activate
      oXL.activecell.Value="DS Root"
      oXL.activecell.offset(0, 1).Value="First Name"
      oXL.activecell.offset(0, 2).Value="Last Name"
      oXL.activecell.offset(0, 3).Value="E-mail (reply)"
      oXL.activecell.offset(0, 4).Value="SAM Account"
      oXL.activecell.offset(0, 5).Value="Work Phone"
      oXL.activecell.offset(0, 6).Value="Mobile"
      oXL.activecell.offset(0, 7).Value="Company"
      oXL.activecell.offset(0, .Value="Address"
      oXL.activecell.offset(0, 9).Value="P. O. Box"
      oXL.activecell.offset(0, 10).Value="Postal Code"
      oXL.activecell.offset(0, 11).Value="State/Province" 'State/Province
      oXL.activecell.offset(0, 12).Value="City" 'city
      oXL.activecell.offset(0, 13).Value="Mail alias" 'mail alias
      oXL.activecell.offset(0, 14).Value="Description"
      oXL.activecell.offset(0, 15).Value="Title"
      oXL.activecell.offset(0, 16).Value="Department"
      oXL.activecell.offset(0, 17).Value="Country" 'Country
      oXL.activecell.offset(0, 1.Value="Home Phone"
      oXL.activecell.offset(0, 19).Value="Fax" ' FAX
      oXL.activecell.offset(0, 20).Value="Pager"
      oXL.activecell.offset(0, 21).Value="Common Name (CN)"
      oXL.activecell.offset(0, 22).Value="msExchUseOAB" 'DN of OAL in use by this user
      oXL.activecell.offset(0, 23).Value="msExchQueryBaseDN" 'DN of Address list or OU to use for search in OWA
      
      oXL.ActiveSheet.range("A2").Activate ' this cell has the DS root in it
      oXL.activecell.Value=root
      oXL.activecell.offset(1, 0).Activate
      
      
      sOU = InputBox("Enter OU(s)" & vbcrlf & "Examples:" & vbcrlf & "ou=users" & vbcrlf & _
      	"ou=users,ou=leading,ou=noname", "Dump Cust Users - OU info", "ou=users")
      If sOU = "" Then ' Cancelled by the user
         WScript.quit
      End If
      
      ' Use ADO to search the domain for all computers.
      Set adoConnection = CreateObject("ADODB.Connection")
      Set adoCommand = CreateObject("ADODB.Command")
      adoConnection.Provider = "ADsDSOOBject"
      adoConnection.Open "Active Directory Provider"
      Set adoCommand.ActiveConnection = adoConnection
      
      ' Determine the DNS domain from the RootDSE object.
      Set objRootDSE = GetObject("LDAP://RootDSE")
      strDNSDomain = objRootDSE.Get("DefaultNamingContext")
      
      ' Filter to retrieve all user objects.
      strFilter = "(objectCategory=user)"
      
      strQuery = "<LDAP://" & sOU & "," & strDNSDomain & ">;" & strFilter _
          & ";subtree"  'here is your filter for sub OU's
      
      adoCommand.CommandText = strQuery
      adoCommand.Properties("Page Size") = 100
      adoCommand.Properties("Timeout") = 30
      adoCommand.Properties("Cache Results") = False
      
      Set objRecordSet = adoCommand.Execute
         If NOT objRecordSet.eof Then
            objRecordSet.MoveFirst
               While Not objRecordset.EOF
          	    Set oUser = GetObject(objRecordSet.Fields("AdsPath").Value)
      
                  oUser.GetInfo
                  ' Start to count
                  Count=Count + 1
                  'ou=dummy,ou=testkunde,ou=customers
                  oXL.activecell.Value=ou
      
                  On Error Resume Next
                  'Fill Excel with info from AD
      
                  oXL.activecell.offset(0, 1).Value=oUser.Get("givenName")
                  oXL.activecell.offset(0, 2).Value=oUser.Get("sn")
                  oXL.activecell.offset(0, 3).Value=oUser.Get("mail")
                  oXL.activecell.offset(0, 4).Value=oUser.Get("sAMAccountName")
                  oXL.activecell.offset(0, 5).Value=oUser.Get("telephoneNumber")
                  oXL.activecell.offset(0, 6).Value=oUser.Get("mobile")
                  oXL.activecell.offset(0, 7).Value=oUser.Get("company")
                  oXL.activecell.offset(0, .Value=oUser.Get("streetAddress")
                  oXL.activecell.offset(0, 9).Value=oUser.Get("PostOfficeBox")
                  oXL.activecell.offset(0, 10).Value=oUser.Get("postalCode")
                  oXL.activecell.offset(0, 11).Value=oUser.Get("st") 'State/Province
                  oXL.activecell.offset(0, 12).Value=oUser.Get("l") 'city
                  ' Get the e-mail address array
                  aProxy = oUser.ProxyAddresses
      
                     For intCount = LBound(aProxy) To UBound(aProxy)
                        ProxyAddressesList=ProxyAddressesList & aProxy(intCount) & ","
                     Next
      
                  oXL.activecell.offset(0, 13).Value=ProxyAddressesList
                  ProxyAddressesList=""
                  oXL.activecell.offset(0, 14).Value=oUser.Get("description")
                  oXL.activecell.offset(0, 15).Value=oUser.Get("title")
                  oXL.activecell.offset(0, 16).Value=oUser.Get("department")
                  oXL.activecell.offset(0, 17).Value=oUser.Get("c") 'Country
                  oXL.activecell.offset(0, 1.Value=oUser.Get("homePhone")
                  oXL.activecell.offset(0, 19).Value=oUser.Get("facsimileTelephoneNumber") ' FAX
                  oXL.activecell.offset(0, 20).Value=oUser.Get("pager")
                  oXL.activecell.offset(0, 21).Value=oUser.Get("cn")
                  oXL.activecell.offset(0, 22).Value=oUser.Get("msExchUseOAB")
                  oXL.activecell.offset(0, 23).Value=oUser.Get("msExchQueryBaseDN")
      
                  ' Concactenate into givenName_and_sn for to check for minimum requiered info
                  givenName_and_sn=givenName_ & sn_
                  ' Used to track line in spreasheet with missing mandatory values
                  LineCount=Count+oucount
                  'Compose the user common name name from first and last names...
                  uname = "CN=" + oXL.activecell.offset(0, 1).Value + " " + oXL.activecell.offset(0, 2).Value
                  ' Step to next row
                  oXL.activecell.offset(1, 0).Activate
               
                  objRecordSet.MoveNext
               Wend
         End If
      
      oXL.activecell.offset(5, 0).Activate
      oXL.activecell.Value="e_n_d"
      oXL.activecell.font.ColorIndex=xlAutomatic
      oXL.activecell.offset(2, 0).Activate
      oXL.activecell.Value="Blue = At least one of the cells in the two rows must contain a value when creating a new user"
      oXL.activecell.font.bold=True
      oXL.activecell.font.ColorIndex=5 'Blue
      oXL.activecell.offset(1, 0).Activate
      oXL.activecell.Value="Red = Cell value must be present when creating a new user"
      oXL.activecell.font.bold=True
      oXL.activecell.font.ColorIndex=3 'Red
      oXL.activecell.offset(1, 0).Activate
      oXL.activecell.Value="Green = Not yet implimented (i.e. column will be ignoreeed)"
      oXL.activecell.font.bold=True
      oXL.activecell.font.ColorIndex=10 'Green
      oXL.activecell.offset(2, 0).Activate
      oXL.activecell.Value="e_n_d marks the ending of the scripts traversal of the spreadsheet - anything can be written in the rows/columns after the e_n_d statement"
      oXL.activecell.font.ColorIndex=xlAutomatic
      oXL.activecell.offset(2, 0).Activate
      oXL.activecell.Value="Anything can be written in a row from column B and outwards as long as the beginning of the row (cell in column A) is blank"
      oXL.activecell.font.ColorIndex=xlAutomatic
      oXL.application.quit
      
      'cleanup
      Set oContainer = Nothing
      WScript.Echo "Finished - " & count & " user(s) dumped"& vbcrlf & vbcrlf & "Remember to save the Worksheet!!!"
      Last edited by ekrengel; 22nd October 2009, 14:52.

      Comment


      • #4
        Re: Need help to search sub OU

        I can't get your script to work. I get the following message:

        Linje: 136
        Tegn: 1
        Error: The table doesn't excist
        Code: 80040E37
        Source: Provider

        Comment


        • #5
          Re: Need help to search sub OU

          I'm not sure as to why it's getting that error...It's not liking the ldap query for some reason. Might have to re-write the script instead of trying to make it work with what you had.

          If I have time today, I'll try to write something up.

          Comment


          • #6
            Re: Need help to search sub OU

            How about this (tested and works for me):

            This will create an excel file to "C:\export.xls". If some of the data doesn't show up, its most likely because it isn't there in AD For the "msExchQueryBaseDN" and "msExchUseOAB" attribuites, if they are attributes...not sure what you're trying to get there.

            Code:
            Const Excel2007 = 12
            
            sXLS = "C:\export.xls"
            
            sOU = InputBox("Enter OU(s)" & vbcrlf & "Examples:" & vbcrlf & "ou=users" & vbcrlf & _
            	"ou=users,ou=leading,ou=noname", "Dump Cust Users - OU info", "ou=users")
            If sOU = "" Then ' Cancelled by the user
               WScript.quit
            End If
            
            Set objRootDSE = GetObject("LDAP://rootDSE")
            strDNSDomain = objRootDSE.Get("defaultNamingContext")
            
            Set objCommand = CreateObject("ADODB.Command")
            Set objConnection = CreateObject("ADODB.Connection")
            objConnection.Provider = "ADsDSOObject"
            objConnection.Open "Active Directory Provider"
               With objCommand
                 .ActiveConnection = objConnection
                 StartNode = strDNSDomain
                 SearchScope = "subtree"
                 FilterString = "(objectCategory=user)"
                 Attributes = "adspath"
                 LDAPQuery = "<LDAP://" & sOU & "," & StartNode & ">;" & FilterString & ";" _
                        	& Attributes & ";" & SearchScope
                 .CommandText = LDAPQuery
                 .Properties("Page Size") = 100
                 .Properties("Timeout") = 30
                 .Properties("Cache Results") = False
                 Set objRecordSet = .Execute
               End With
            
            With CreateObject("Excel.Application")
               .Application.DisplayAlerts = False
               .Visible = True
               .Workbooks.Add
               .Cells(1,1).Value = "First Name"
               .Cells(1,2).Value = "Last Name"
               .Cells(1,3).Value = "E-Mail (reply)"
               .Cells(1,4).Value = "SAM Account"
               .Cells(1,5).Value = "Work Phone"
               .Cells(1,6).Value = "Mobile"
               .Cells(1,7).Value = "Company"
               .Cells(1,8).Value = "Address"
               .Cells(1,9).Value = "P. O. Box"
               .Cells(1,10).Value = "Postal Code"
               .Cells(1,11).Value = "State/Province"
               .Cells(1,12).Value = "City"
               .Cells(1,13).Value = "Description"
               .Cells(1,14).Value = "Title"
               .Cells(1,15).Value = "Department"
               .Cells(1,16).Value = "Country"
               .Cells(1,17).Value = "Home Phone"
               .Cells(1,18).Value = "Fax"
               .Cells(1,19).Value = "Pager"
               .Cells(1,20).Value = "Common Name (CN)"
               .Cells(1,21).Value = "msExchUseOAB"
               .Cells(1,22).Value = "msExchQueryBaseDN"
               xRow = 1 : yColumn = 1
                  Do Until yColumn = 23
            	 With .Cells(xRow,yColumn)
                   	    .Font.Bold = True
                	    .Font.Size = 11
                	    .Interior.ColorIndex = 11 
                	    .Interior.Pattern = 1
                	    .Font.ColorIndex = 2
                	    .Borders.LineStyle = 1
                	    .WrapText = True
                     End With
               yColumn = yColumn + 1 : Loop
               x = 2 : y = 1
                  If NOT objRecordSet.eof Then
                  objRecordSet.MoveFirst
              	 While Not objRecordset.EOF
                      Set objUser = GetObject(objRecordSet.Fields("AdsPath").Value)
            
                  	    .Cells(x,y).Value = objUser.givenName : y = y + 1
                  	    .Cells(x,y).Value = objUser.sn : y = y + 1
                  	    .Cells(x,y).Value = objUser.mail : y = y + 1
                  	    .Cells(x,y).Value = objUser.sAMAccountName : y = y + 1
                  	    .Cells(x,y).Value = objUser.telephoneNumber : y = y + 1
                  	    .Cells(x,y).Value = objUser.mobile : y = y + 1
                  	    .Cells(x,y).Value = objUser.company : y = y + 1
                  	    .Cells(x,y).Value = objUser.streetAddress : y = y + 1
                  	    .Cells(x,y).Value = objUser.PostOfficeBox : y = y + 1
                  	    .Cells(x,y).Value = objUser.postalCode : y = y + 1
                  	    .Cells(x,y).Value = objUser.st : y = y + 1
                        .Cells(x,y).Value = objUser.l : y = y + 1
            	       aProxy = objUser.ProxyAddresses
                           For intCount = LBound(aProxy) To UBound(aProxy)
                              ProxyAddressesList=ProxyAddressesList & aProxy(intCount) & ","
                           Next
                  	    .Cells(x,y).Value = ProxyAddressList : y = y + 1
                  	    .Cells(x,y).Value = objUser.description : y = y + 1
                        .Cells(x,y).Value = objUser.title : y = y + 1
                        .Cells(x,y).Value = objUser.department : y = y + 1
                        .Cells(x,y).Value = objUser.c : y = y + 1
                        .Cells(x,y).Value = objUser.homePhone : y1 = y1 + 1
                  	    .Cells(x,y).Value = objUser.facsimileTelephoneNumber : y = y + 1
                  	    .Cells(x,y).Value = objUser.pager : y = y + 1
                  	    .Cells(x,y).Value = objUser.cn : y = y + 1
                  	    .Cells(x,y).Value = objUser.msExchUseOAB : y = y + 1
                  	    .Cells(x,y).Value = objUser.msExchQueryBaseDN
            
                  	  x = x + 1 : y = 1
                      objRecordSet.MoveNext
              	 Wend
                  End If
                .Columns("A:V").Select
                .Selection.HorizontalAlignment = 3 	'center all data
                .Selection.Borders.LineStyle = 1 	'apply borders
                .Columns("A:AH").EntireColumn.AutoFit  'autofit all columns
                   appVerInt = split(.Version, ".")(0)
                   If appVerInt-Excel2007 >=0 Then
                      .ActiveWorkbook.SaveAs(sXLS), 56  'office 2007
                   Else
              	  .ActiveWorkbook.SaveAs(sXLS), 43  'office 2003
                   End If
                .Quit
            End With
            
            Set objCommand = Nothing
            Set objConnection = Nothing
            
            msgbox "Done!"
            WScript.Quit
            Last edited by ekrengel; 28th October 2009, 21:39. Reason: Cleaned up a little...

            Comment


            • #7
              Re: Need help to search sub OU

              Thanks alot!! This works like a charm Thanks!

              Comment

              Working...
              X