Help w/ looping through one worksheet for input to another

[fsck66]

Hello -

I am working on a script that is based on the excellent NTUser.vbs script written by Ralph Montgomery. I have modified the code so that it pulls data out of one worksheet (usernames), fetches domain values for each of the accounts, and writes the results to a second worksheet.

My problem is that it is only working partially. To summarize, I am using a single workbook containing two worksheets. Worksheet 1 is where the script reads from, and it is just one column with a list of sAMAccountNames. Worksheet 2 is where the script writes the output to for each of the sAMAccountNames after fetching the values from the domain. My problem seems to be that I do not know how to code the Loop such that it increments to the next Row for each of worksheets as it parses through the sAMAccountNames. As a result, the script succeeds only for the first row (it reads first row of INPUT worksheet an writes first row of OUTPUT worksheet but it does not process the subsequent rows. I attempted to do this by using intReadRow = intReadRow + 1 and intWriteRow = intWriteRow + 1, followed by a 'Loop' but that doesn't work.

I am somewhat experienced with vbscript but I am at a complete lost with this part. Does anyone know how I can accomplish this 'Loop' process? Code is below (I have commented it as much as possible). Thanks in advance for any help you can provide...

' Abridged original remarks from Ralph Mongtomery
' Get User Information NTUser.wsf
' Version 1.0 Created 11-26-2001 by Ralph Montgomery (rmonty@myself.com)

' Alan Kaplan remarks
' 3/23/2009 I have been using this script for a very long time, and have probably hacked
' it beyond recognition. I take neither the credit nor the blame for the clumsy bits...
' I stripped out Win9x stuff, and system info detection, as everyone I know
' using this is at XP or later.

'10/23/2009 added support for and enumeration of UPN

Option Explicit
Dim strUserName, objUserDomain, objGroup, objUser, strGroupList
Dim WshShell, strMessage, strTitle
Dim oDomain, strNTDomain, strVer
Dim strSortedGroups, arrGroupList, strUserList
Dim objChangePwdTrue, objChangePwd, objUserProfile
Dim objPwdExpiresTrue, objFlags, oPwdExpire, strPwdExpires, iAdminCount, dPwdLastChanged, iAutoUnlock
Dim objAcctDisabled, intPwdExpired, objPwdExpiredTrue, objPwdExpires,bAccountDisabled
Dim StrQuote, iBadLogins, iMaxPadPw, iAccountLockout, iPwdAge, intPwdHistory
Dim strExcelPath, objExcel, objSheet, intReadRow, strUserDN, strPassword, xlExcel7, intWriteRow
Set WshShell = WScript.CreateObject("WScript.Shell")
strVer = "Ver 3.1 "
strQuote = Chr(34)
Dim strNTName, strUPN
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1
Const ADS_NAME_TYPE_USER_PRINCIPAL_NAME = 9
Dim strNTUserName
Const ADS_NAME_INITTYPE_DOMAIN = 1
Const ADS_NAME_TYPE_UNKNOWN = 8
Const ADS_NAME_TYPE_CANONICAL = 2

Dim oTrans
Set oTrans = CreateObject("NameTranslate")

' Check for required script arguments
If (Wscript.Arguments.Count < 1) Then
Wscript.Echo "Arguments <FileName> required. For example:" & vbCrLf _
& "cscript enumaccountpolicies.vbs c:\spreadsheet.xls"
Wscript.Quit(0)
End If

' Pull Environment variables for domain/user
strNTDomain = WshShell.ExpandEnvironmentStrings("%USERDOMAIN%")
strNTUserName = ucase(WshShell.ExpandEnvironmentStrings("%USERNAME%"))


'------------------------------------------MAIN----------------------------------------------

Call Excel
Call ExcelAddOutputSheet
Call GetandWriteInfo


' Format the spreadsheet.
'objSheet.Range("A1:A5").Font.Bold = True
'objSheet.Select
'objSheet.Range("B5").Select
'objExcel.ActiveWindow.FreezePanes = True
'objExcel.Columns(1).ColumnWidth = 20
'objExcel.Columns(2).ColumnWidth = 30

' Save the spreadsheet and close the workbook.
objExcel.ActiveWorkbook.SaveAs strExcelPath
objExcel.ActiveWorkbook.Close

' Quit Excel.
objExcel.Application.Quit

' Clean up.
Set objUser = Nothing
Set objExcel = Nothing
Set objSheet = Nothing

Wscript.Echo "Done"

'---------------------------------------------END MAIN-------------------------------------------



'''''''''Subs and Functions ''''''''''

Sub Excel 'Bind to Excel object and Workbook

' Define Workbook Path
strExcelPath = Wscript.Arguments(0)

' Bind to Excel object
On Error Resume Next
Set objExcel = CreateObject("Excel.Application")
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Excel application not found"
Wscript.Quit
End If
objExcel.Visible = True
On Error GoTo 0

' Bind to Workbook
On Error Resume Next
objExcel.Workbooks.Open strExcelPath
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "Spreadsheet cannot be opened: " & strExcelPath
Wscript.Quit
End If
On Error GoTo 0
End Sub


Sub ExcelReadSheet 'Bind to INPUT Worksheet in Workbook
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
End Sub


Sub ExcelWritesheet 'Bind to OUTPUT Worksheet in Workbook
Set objSheet = objExcel.ActiveWorkbook.Worksheets(2)
End Sub


Sub ExcelAddOutputSheet 'Populate Headings in OUTPUT Worksheet

'Bind to OuTPUT worksheet in current Workbook
Call ExcelWriteSheet
'Name Worksheet
objSheet.Name = "Audit Results"
'Populate
objSheet.Cells(1, 1).Value = "Account Attributes"
objSheet.Cells(1, 2).Value = "Date & Time of Retrieval: " & (NOW())
objSheet.Cells(3, 1).Value = "Full Name"
objSheet.Cells(3, 2).Value = "Account Name"
objSheet.Cells(3, 3).Value = "Description"
objSheet.Cells(3, 4).Value = "Account Disabled"
objSheet.Cells(3, 5).Value = "Account Locked Out"
objSheet.Cells(3, 6).Value = "Bad Logins"
objSheet.Cells(3, 7).Value = "~Last Logon"
objSheet.Cells(3, 8).Value = "Max Password Attempts"
objSheet.Cells(3, 9).Value = "Attempts Left"
objSheet.Cells(3, 10).Value = "Password Never Expires"
objSheet.Cells(3, 11).Value = "Password Expired?"
objSheet.Cells(3, 12).Value = "Password Age"
objSheet.Cells(3, 13).Value = "Password Last Changed"
objSheet.Cells(3, 14).Value = "Password Next Change"
objSheet.Cells(3, 15).Value = "User can Change Password"
objSheet.Cells(3, 16).Value = "Password Minimum Length"
objSheet.Cells(3, 17).Value = "Passwords Kept in History"
objSheet.Cells(3, 18).Value = "Lock-out Time"
objSheet.Cells(3, 19).Value = "Auto-Unlock Time"
objSheet.Cells(3, 20).Value = "Group Memberships"
End Sub


Sub GetandWriteInfo 'Reads INPUT Worksheet, Fetches Parameters, and writes to OUTPUT Worksheet

'Read INPUT Worksheet
Call ExcelReadSheet

'The first row of the input worksheet is skipped (column headings).
'Each row after the first is processed until the first blank entry
'in the first column is encountered.
intReadRow = 2
Do While objSheet.Cells(intReadRow, 1).Value <> ""
strUserName = objSheet.Cells(intReadRow, 1).Value
strNTUserName = strUserName
On Error Resume Next

'Attempt to bind to the user account
Set objUser = GetObject("WinNT://"& strNTDomain & "/" & strNTUserName & ", user")
If (Err.Number <> 0) Then
On Error GoTo 0
Wscript.Echo "User NOT found: " & strNTUserName

Else

''''''Fetch Account Parameters''''''
On Error resume Next
' Creates the list of groups the user belongs To
For Each objGroup In objUser.Groups
If strGroupList = "" Then
strGroupList = objGroup.Name
Else
strGroupList = strGroupList & ", " & objGroup.Name
End If
Next
' Convert strgrouplist to Array
arrGroupList = Split(strGroupList,",")
'Sort the darn thing
Quicksort arrGroupList, LBound(arrGroupList), UBound(arrGroupList)
' Now concatenate arrGroupList into a variable for display
strSortedGroups = trim(Join(arrGroupList, ", "))

'check for expired password
intPwdExpired = objUser.Get("PasswordExpired")
If intPwdExpired = 1 Then
objPwdExpiredTrue = "Yes"
Else objPwdExpiredTrue = "No"
End If

'Check for Must Change Password Flag
objFlags = objUser.Get("UserFlags")
If (objFlags And &H00040) <> 0 Then
objChangePwdTrue = "No"
Else objChangePwdTrue = "Yes"
End If

' Is password set to NEVER expire?
objPwdExpires = objUser.Get("UserFlags")
If (objPwdExpires And &H10000) <> 0 Then
objPwdExpiresTrue = "Yes"
strPwdExpires = "Date Set: "
Else objPwdExpiresTrue = "No"
strPwdExpires = "Password Expires: "
End If

' Is the account disabled?
If objUser.AccountDisabled = True Then
bAccountDisabled = "Yes"
Else bAccountDisabled = "No"
End If

'How many wrong logins?
iBadLogins = objUser.BadPasswordAttempts

'Maximum bad password attempts?
iMaxPadPw = objUser.MaxBadPasswordsAllowed

'Account Lockout Observation Interval
iAccountLockout = FormatNumber((objUser.LockoutObservationInterval/60), 0)

'How old is the current password?
iPwdAge = FormatNumber(((objUser.Get("PasswordAge")/60)/60)/24, 0)

'Calculate the date the password was last changed
dPwdLastChanged = CStr(objUser.PasswordExpirationDate - objUser.Get("MaxPasswordAge") / (60 * 60 * 24))

iAdminCount = objUser.Get("AdminCount")

'Set Profile path to tabs if blank
objUserProfile = objUser.Profile
If objUserProfile = "" Then
objUserProfile= "<None>" & vbTab
Else objUserProfile = objUserProfile
End If

'Determine how many passwords are saved
Set oDomain = GetObject("WinNT://" & strNTDomain)
intPwdHistory = oDomain.PasswordHistoryLength
iAutoUnlock = oDomain.AutoUnlockInterval/60


'Bind to OUTPUT Worksheet in current Workbook
Call ExcelWriteSheet
'Write results to OUTPUT Worksheet
Call Writeinfo

End If

'Attempt to process next worksheet rows via Loop
intReadRow = intReadRow + 1
'intWriteRow = intWriteRow + 1
Loop

End Sub


Sub WriteInfo 'Writes Fetched Parameters to OUTPUT Worksheet

'Write values to OUTPUT Worksheet
intWriteRow = 4
objSheet.Cells(intWriteRow, 1).Value = objUser.FullName
objSheet.Cells(intWriteRow, 2).Value = strNTDomain & "\" & strNTUserName
objSheet.Cells(intWriteRow, 3).Value = objUser.Description
objSheet.Cells(intWriteRow, 4).Value = bAccountDisabled
objSheet.Cells(intWriteRow, 5).Value = objUser.IsAccountLocked
objSheet.Cells(intWriteRow, 6).Value = iBadLogins
objSheet.Cells(intWriteRow, 7).Value = objUser.LastLogin
objSheet.Cells(intWriteRow, 8).Value = iMaxPadPw
objSheet.Cells(intWriteRow, 9).Value = iMaxPadPw - iBadLogins
objSheet.Cells(intWriteRow, 10).Value = objPwdExpiresTrue
objSheet.Cells(intWriteRow, 11).Value = objPwdExpiredTrue
objSheet.Cells(intWriteRow, 12).Value = iPwdAge
objSheet.Cells(intWriteRow, 13).Value = dPwdLastChanged
objSheet.Cells(intWriteRow, 14).Value = strPwdExpires
objSheet.Cells(intWriteRow, 15).Value = objChangePwdTrue
objSheet.Cells(intWriteRow, 16).Value = objUser.PasswordMinimumLength
objSheet.Cells(intWriteRow, 17).Value = intPwdHistory & " password(s)"
objSheet.Cells(intWriteRow, 18).Value = iAccountLockout & " minutes"
objSheet.Cells(intWriteRow, 19).Value = iAutoUnlock & " minutes"
objSheet.Cells(intWriteRow, 20).Value = strSortedGroups

End Sub


Sub Quicksort(strValues(), ByVal min, ByVal max) 'Sorts the items in the array (between the two values you pass in)
Dim strMediumValue, high, low, i

'If the list has only 1 item, it's sorted.
If min >= max Then Exit Sub

' Pick a dividing item randomly.
i = min + Int(Rnd(max - min + 1))
strMediumValue = strValues(i)

' Swap the dividing item to the front of the list.
strValues(i) = strValues(min)

' Separate the list into sublists.
low = min
high = max
Do
' Look down from high for a value < strMediumValue.
Do While strValues(high) >= strMediumValue
high = high - 1
If high <= low Then Exit Do
Loop

If high <= low Then
'The list is separated.
strValues(low) = strMediumValue
Exit Do
End If

'Swap the low and high strValues.
strValues(low) = strValues(high)

'Look up from low for a value >= strMediumValue.
low = low + 1
Do While strValues(low) < strMediumValue
low = low + 1
If low >= high Then Exit Do
Loop

If low >= high Then
'The list is separated.
low = high
strValues(high) = strMediumValue
Exit Do
End If

'Swap the low and high strValues.
strValues(high) = strValues(low)
Loop 'Loop until the list is separated.

'Recursively sort the sublists.
Quicksort strValues, min, low - 1
Quicksort strValues, low + 1, max

End Sub


Function GetUPN (strNTName)
On Error Resume Next
oTrans.Init ADS_NAME_INITTYPE_GC, ""
oTrans.Set ADS_NAME_TYPE_UNKNOWN,strNTName
If Err <> 0 Then
MsgBox "Unable to lookup " & strNTName,vbCritical + vbOKOnly,"Error"
WScript.Quit
End If
GetUPN = oTrans.Get(5)
End Function


Function GetNTPath (strUPN)
On Error Resume next
oTrans.Init ADS_NAME_INITTYPE_GC, ""
oTrans.Set ADS_NAME_TYPE_USER_PRINCIPAL_NAME,strUPN
If Err <> 0 Then
MsgBox "Unable to lookup " & strUPN,vbCritical + vbOKOnly,"Error"
WScript.Quit
End If

GetNTPath = oTrans.Get(ADS_NAME_TYPE_NT4)
GetNTPath = Replace(GetNTPath,"\","/")
End Function

 

[SkipVought]

hi,

My problem seems to be that I do not know how to code the Loop such that it increments to the next Row for each of worksheets as it parses through the sAMAccountNames

Is there a one to one relationship between rows in sheet1 and sheet2?

dim r as excel.range

'assuming that you want to loop thru the values in column A on sheet CodeName Sheet1 starting in A1 
with xlWB.Sheet1
  for each r in .range(.{A1], .[A1].end(xldown))
     'now write to sheet CodeName Sheet2
     xlWB.Sheet2.Cells(r.row, r.column).value = something
  next
end with

Skip,
[sub]
Just traded in my old subtlety...
for a NUANCE![/sub]