yellowartist
IS-IT--Management
I am trying to pull out a some attributes from a user's Active Directory account that is a member of a specific group and place it into a spreadsheet.
I cannot get it to list the SMTP addresses and the groups. I also cannot get it to loop through all users.
Here is the script.
Option Explicit
on error resume next
Dim objGroup, objuser, objExcel, iRow, strUser, iCol
dim strExcelPath, objApp
strExcelPath = "\\Server\folder\Scripts\EMP_SEP\Work_Log.xls"
set objExcel = CreateObject("Excel.Application")
' Create a new workbook.
objExcel.Workbooks.Add
' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "Work_Log"
' Populate spreadsheet cells with user attributes.
Set objGroup = GetObject("LDAP://CN=GG_ES_ACCT_ADMIN,OU=Groups,OU=KBS,DC=kochind,DC=com")
Set objExcel = CreateObject("Excel.Application")
With objExcel
.SheetsInNewWorkbook = 1
.Workbooks.Add
.Visible = false
iRow=1
For Each strUser in objGroup.Member
Set objUser = GetObject("LDAP://" & strUser)
.Cells(irow,1) = ("User Name: " & objUser.CN)
.Cells(irow,2) = ("Role ID: " & objUser.sAMAccountName)
.Cells(irow,3) = ("Object(s): " & objUser.distinguishedName)
.Cells(irow,4) = ("Home Drive: " & objUser.homeDirectory)
.Cells(irow,6) = ("Mailbox Store: " & objUser.homeMDB)
.Cells(irow,7) = ("ALIAS: " & objuser.mailNickname)
.Cells(irow,8) = ("Email Address(es): " & objuser.Getex("proxyAddresses"))
.Cells(irow,9) = ("Groups: " & Objgroup.Getex("memberof"))
.Cells(irow,10) = " "
.cells(irow,11) = "Disabled the AD account (Do not perform this step for KST)"
.Cells(irow,12) = "Changed Password"
.cells(irow,13) = "Set Delivery Restrictions – Accept Messages: Only from: MAILTEAM (do not perform this step if email is being forwarded)"
.cells(irow,14) = "Hid from Exchange address list (Do not perform this step for FHR)"
.cells(irow,15) = "Added EXEMPT in Extension Attribute 5"
.cells(irow,16) = "Added to GG_KBS_ES"
.cells(irow,17) = "Inserted current date in MM/DD/YY format to AD account Full name and Display name: "
irow + 1
Next
End With
' Save the spreadsheet, close the workbook and exit.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
'WScript.Echo "Spreadsheet Created"
'Set objApp = CreateObject("WScript.Shell")
'objApp.Run "cmd /C net use n: \\Server\folder\Scripts\EMP_SEP [Password] & n: & EnumerateMembers"
I cannot get it to list the SMTP addresses and the groups. I also cannot get it to loop through all users.
Here is the script.
Option Explicit
on error resume next
Dim objGroup, objuser, objExcel, iRow, strUser, iCol
dim strExcelPath, objApp
strExcelPath = "\\Server\folder\Scripts\EMP_SEP\Work_Log.xls"
set objExcel = CreateObject("Excel.Application")
' Create a new workbook.
objExcel.Workbooks.Add
' Bind to worksheet.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
objSheet.Name = "Work_Log"
' Populate spreadsheet cells with user attributes.
Set objGroup = GetObject("LDAP://CN=GG_ES_ACCT_ADMIN,OU=Groups,OU=KBS,DC=kochind,DC=com")
Set objExcel = CreateObject("Excel.Application")
With objExcel
.SheetsInNewWorkbook = 1
.Workbooks.Add
.Visible = false
iRow=1
For Each strUser in objGroup.Member
Set objUser = GetObject("LDAP://" & strUser)
.Cells(irow,1) = ("User Name: " & objUser.CN)
.Cells(irow,2) = ("Role ID: " & objUser.sAMAccountName)
.Cells(irow,3) = ("Object(s): " & objUser.distinguishedName)
.Cells(irow,4) = ("Home Drive: " & objUser.homeDirectory)
.Cells(irow,6) = ("Mailbox Store: " & objUser.homeMDB)
.Cells(irow,7) = ("ALIAS: " & objuser.mailNickname)
.Cells(irow,8) = ("Email Address(es): " & objuser.Getex("proxyAddresses"))
.Cells(irow,9) = ("Groups: " & Objgroup.Getex("memberof"))
.Cells(irow,10) = " "
.cells(irow,11) = "Disabled the AD account (Do not perform this step for KST)"
.Cells(irow,12) = "Changed Password"
.cells(irow,13) = "Set Delivery Restrictions – Accept Messages: Only from: MAILTEAM (do not perform this step if email is being forwarded)"
.cells(irow,14) = "Hid from Exchange address list (Do not perform this step for FHR)"
.cells(irow,15) = "Added EXEMPT in Extension Attribute 5"
.cells(irow,16) = "Added to GG_KBS_ES"
.cells(irow,17) = "Inserted current date in MM/DD/YY format to AD account Full name and Display name: "
irow + 1
Next
End With
' Save the spreadsheet, close the workbook and exit.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
'WScript.Echo "Spreadsheet Created"
'Set objApp = CreateObject("WScript.Shell")
'objApp.Run "cmd /C net use n: \\Server\folder\Scripts\EMP_SEP [Password] & n: & EnumerateMembers"