Collect Users Info In Group
Posted: Fri Jun 22, 2012 12:28 am
Good morning question I'm new to VB scripting i've been doing CRON scripting to long, anyways; I found a VB-Script for gathering users and there information from a group. I was wondering if I could get some assistance on making a few changes.1: once the script is executed I'd like for it to ask for the group name.2: I'd like for the file to be saved in the parent folder without having to put in a hard path like "C:" this way I don't have to worry about remembering to change the path if I copy it to another machine.
; Anyways here's the script hope that someone can assist;VB Code Start Block *****************************************************************
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 ''Enter the group name''Dim strGroup : strGroup = "VPN_USERS" Dim objGroup : Set objGroup = GetObject("LDAP://" & GetDN(strGroup)) Enum_Members(objGroup) Format_It() Save_It() Sub Create_Excel_Header() With objSheet .Name = "Data" .Cells(1, 1).Value = "User ID" .Cells(1, 2).Value = "First Name" .Cells(1, 3).Value = "Initials" .Cells(1, 4).Value = "Last Name" .Cells(1, 5).Value = "E-Mail" .Cells(1, 6).Value = "Office Location" .Cells(1, 7).Value = "Description" .Cells(1, 8).Value = "Job Title" .Cells(1, 9).Value = "Department" .Cells(1, 10).Value = "Manager" .Cells(1, 11).Value = "IP Phone" .Cells(1, 12).Value = "Mobile Phone" .Cells(1, 13).Value = "Pager Number" .Cells(1, 14).Value = "Fax Number" .Cells(1, 15).Value = "Home Phone"
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("C:0000000000000000000MTA_Collect_Individual_Users_In_Group_Information.xlsx") objExcel.Quit End Sub Sub Enum_Members(group) Dim arrAttributes : arrAttributes = Array("samaccountName", "GivenName", "Initials", "sn", "Mail", "physicaldeliveryofficename", "Description", "Title", "Department", "Manager", "IPPhone", "Mobile", "Pager", "facsimileTelephoneNumber", "homePhone") Dim objItem For Each objItem in group.Members If objItem.Class = "user" Then Dim intColumn : intColumn = 1 Dim objUser : Set objUser = GetObject(objItem.AdsPath) Dim strAttrib For Each strAttrib in arrAttributes On Error Resume Next objSheet.Cells(intRow, intColumn).Value = objItem.Get(strAttrib) On Error GoTo 0 intColumn = intColumn + 1 Next End If intRow = intRow + 1 Next For Each objItem in group.Members If objItem.Class = "group" Then Call Enum_Members(objItem) End If 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;VB Code End Block*****************************************************************
; Anyways here's the script hope that someone can assist;VB Code Start Block *****************************************************************
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 ''Enter the group name''Dim strGroup : strGroup = "VPN_USERS" Dim objGroup : Set objGroup = GetObject("LDAP://" & GetDN(strGroup)) Enum_Members(objGroup) Format_It() Save_It() Sub Create_Excel_Header() With objSheet .Name = "Data" .Cells(1, 1).Value = "User ID" .Cells(1, 2).Value = "First Name" .Cells(1, 3).Value = "Initials" .Cells(1, 4).Value = "Last Name" .Cells(1, 5).Value = "E-Mail" .Cells(1, 6).Value = "Office Location" .Cells(1, 7).Value = "Description" .Cells(1, 8).Value = "Job Title" .Cells(1, 9).Value = "Department" .Cells(1, 10).Value = "Manager" .Cells(1, 11).Value = "IP Phone" .Cells(1, 12).Value = "Mobile Phone" .Cells(1, 13).Value = "Pager Number" .Cells(1, 14).Value = "Fax Number" .Cells(1, 15).Value = "Home Phone"
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("C:0000000000000000000MTA_Collect_Individual_Users_In_Group_Information.xlsx") objExcel.Quit End Sub Sub Enum_Members(group) Dim arrAttributes : arrAttributes = Array("samaccountName", "GivenName", "Initials", "sn", "Mail", "physicaldeliveryofficename", "Description", "Title", "Department", "Manager", "IPPhone", "Mobile", "Pager", "facsimileTelephoneNumber", "homePhone") Dim objItem For Each objItem in group.Members If objItem.Class = "user" Then Dim intColumn : intColumn = 1 Dim objUser : Set objUser = GetObject(objItem.AdsPath) Dim strAttrib For Each strAttrib in arrAttributes On Error Resume Next objSheet.Cells(intRow, intColumn).Value = objItem.Get(strAttrib) On Error GoTo 0 intColumn = intColumn + 1 Next End If intRow = intRow + 1 Next For Each objItem in group.Members If objItem.Class = "group" Then Call Enum_Members(objItem) End If 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;VB Code End Block*****************************************************************