Hi,
This is my first ever post in this forum!!!
I need a help from you guys in fixing a script which I’ve created (thanks to various sources in the internet
) to generate all the direct and subsequent child reportees for the direct reportees for a given employee.
It works well for the direct reportees as well as for the 1st set of child reportees then the script collapses @ throws "Object not a collection" @ line# 74.
Hope you guys shower me the guidance light to fix it while I continue my quest in fixing it.
Here is the script for your reference and thanks in advance!
Option Explicit
Dim objExcel : Set objExcel = CreateObject("Excel.Application")
With objExcel
.Visible = True
.DisplayAlerts = False
Dim objWorkBook : Set objWorkBook = .WorkBooks.Add
Dim objSheet : Set objSheet = .Worksheets(1)
End With
Create_Excel_Header()
Dim intRow : intRow = 2
Dim objItem, objUser1,objUser12, intColumn
Dim strUser : strUser = "Username"
Dim objUser : Set objUser = GetObject("LDAP://" & GetDN(strUser))
Enum_Members(objUser)
Format_It()
Save_It()
Sub Create_Excel_Header()
With objSheet
.Name = "Data"
.Cells(1, 1).Value = "UserName"
.Cells(1, 2).Value = "First Name"
.Cells(1, 3).Value = "Last Name"
.Cells(1, 4).Value = "Title"
.Cells(1, 5).Value = "Company"
.Cells(1, 6).Value = "Department"
.Cells(1, 7).Value = "Manager Name" End With
Dim objRange : Set objRange = objSheet.UsedRange
objRange.Select
With objRange
.Font.Bold = True
.Font.Name = "Arial"
.Font.Size = 10
.WrapText = False
.HorizontalAlignment = -4108
.Interior.ColorIndex = 37
.Cells.RowHeight = 25
End With
End Sub
Sub Format_It()
Const xlEdgeBottom = 9
Const xlEdgeLeft = 7
Const xlEdgeRight = 10
Const xlEdgeTop = 8
Const xlInsideHorizontal = 12
Const xlInsideVertical = 11
Const xlContinuous = 1
Const xlAutomatic = -4105
Const xlMedium = -4138
Dim objRange : Set objRange = objSheet.UsedRange
objRange.Select
objRange.Columns.AutoFit
Dim arrBorders : arrBorders = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)
Dim intBorder
For Each intBorder in arrBorders
With objRange.Borders(intBorder)
.LineStyle = xlContinuous
.Weight = xlMedium
.ColorIndex = xlAutomatic
End With
Next
End Sub
Sub Save_It()
objExcel.ActiveWorkBook.SaveAs("H:\child_report.xls")
objExcel.Quit
End Sub
Sub Enum_Members(User)
Dim arrAttributes : arrAttributes = Array("samaccountName", "GivenName", "sn", "Title", "company", "department", "manager")
Dim objItem
For Each objItem in User.directreports intColumn = 1 Set objUser1 = GetObject("LDAP://" & objItem)
Dim arrAttributes1: arrAttributes1 = Array(objUser1)
Dim strAttrib
For Each strAttrib in arrAttributes
On Error Resume Next
objSheet.Cells(intRow, intColumn).Value = objUser1.Get(strAttrib)
On Error GoTo 0
intColumn = intColumn + 1
Next
intRow = intRow + 1
Next
Dim objItem12 For Each objItem12 in arrAttributes1 Call Enum_Members(objItem12)
Next End Sub
Function GetDN(samAccount)
If Not IsObject(objWSHNetwork) Then
Dim objWSHNetwork : Set objWSHNetwork = WScript.CreateObject("WScript.Network")
End If
Dim NT : Set NT= CreateObject("NameTranslate")
NT.Init 3, ""
NT.Set 3, objWSHNetwork.UserDomain & "\" & samAccount
GetDN = NT.Get(1)
End Function
<message edited by pbalajieie on Thursday, November 17, 2011 10:54 AM>