Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Register Log in
  • Congratulations Chris Miller on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Loop Problem 1

Status
Not open for further replies.
djtech2k

djtech2k

MIS
Jul 24, 2003
1,097
US
Hi all. I am beating myself up on a rather simple thing, but I keep missing something. I am sure that I will feel like an idiot once you guys help me out of it.

Anyway, I need to write a query to report out users from a domain that meet certain criteria. That is simple. There a couple exceptions:

- Do not report users in certain OU's (have not finished this part...just grabbing Parent as of now)

- Do not report users from a specific list in a text file. The list has an email on each new line.

This is the one I need help with. My loop is messed up and I cannot get it to work. It will report back data now, but the 2 loops are not working together if you know what i mean. Here is the code I am working on. Please excuse it, it is just dev right now. Once this is fixed I plan to clean it up and add the OU exclusion.

Code: 
Option Explicit

Dim objRootDSE, strDNSDomain, objCommand, objConnection
Dim strQuery, strBase, strFilter, strAttributes
Dim objRecordSet, strName, objUser, strParent, objParent
Dim strDN, strFirst, strLast, strEmail, strEmpID
Dim objFSO, objExcludeFile, strBadOU, strEmailCompare
Dim strPreferredEmail, objExcel, intRow, strExcelPath
Dim strExcludeFile, strExcludeFlag, strNextLine

Const ForReading = 1, ForWriting = 2, ForAppending = 8

strBadOU = "test"
intRow = "1"
strExcelPath = "c:\OutPutFile.xls"
strExcludeFile = "c:\test.txt"

   Set objExcel = SetupExcel(strExcelPath)
   objExcel.Cells(intRow, 1).Value = "Name"
   objExcel.Cells(intRow, 2).Value = "First"
   objExcel.Cells(intRow, 3).Value = "Last"
   objExcel.Cells(intRow, 4).Value = "EmployeeID"
   objExcel.Cells(intRow, 5).Value = "Email"
   objExcel.Cells(intRow, 6).Value = "Preferred Email"
   objExcel.Rows(intRow).Interior.ColorIndex = 6
   objExcel.Rows(intRow).Font.Bold = True
   intRow = intRow + 1


Set objFSO = CreateObject("Scripting.FileSystemObject")

If objFSO.FileExists(strExcludeFile) Then
Set objExcludeFile = objFSO.OpenTextFile("c:\test.txt", ForReading)
strExcludeFlag = True
Else
strExcludeFlag = False
End If

' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory.
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection

' Search for all user objects. Return Values.
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)(homeMDB=*)(!userAccountControl:1.2.840.113556.1.4.803:=2))"
strAttributes = "displayName,distinguishedName,givenName,sn,employeeID,mail"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
objCommand.Properties("Sort On") = "displayName"
Set objRecordSet = objCommand.Execute
  
    Do Until objRecordSet.EOF
  strName = objRecordSet.Fields("displayName")
  strDN = objRecordSet.Fields("distinguishedName")
  strFirst = objRecordSet.Fields("givenName")
  strLast = objRecordSet.Fields("sn")
  strEmpID = objRecordSet.Fields("employeeID")
  strEmail = objRecordSet.Fields("mail")

  Set objUser = GetObject("LDAP://" & strDN)
  strParent = objUser.Parent
  Set objParent = GetObject(strParent)

  strEmailCompare = Split(strEmail,"@")
  If strEmailCompare(0) <> strFirst Then
  strPreferredEmail = strEmailCompare(0)
  Else
  strPreferredEmail = ""
  End If
    
If objUser.AccountDisabled = False And Replace(objParent.Name,"CN=","") <> strBadOU And strExcludeFlag = True Then
'Wscript.Echo strName & ";" & Replace(objParent.Name,"CN=","") & ";" & strPreferredEmail
	Do Until objExcludeFile.AtEndOfStream
    strNextLine = objExcludeFile.Readline

	If strNextLine <> strEmail Then
	                objExcel.Cells(intRow, 1).Value = strName
                    objExcel.Cells(intRow, 2).Value = strFirst
                    objExcel.Cells(intRow, 3).Value = strLast
                    objExcel.Cells(intRow, 4).Value = strEmpID
                    objExcel.Cells(intRow, 5).Value = strEmail
                    objExcel.Cells(intRow, 6).Value = strPreferredEmail
					intRow = intRow + 1
		
End If
Loop
End If

    objRecordSet.MoveNext
	Loop

objConnection.Close

Call ExcelCleanUp(objExcel, strExcelPath)

Function SetupExcel(strExcelPath)
    WScript.Echo strExcelPath
    
    ' Check for required arguments.
    If Not strExcelPath <> "" Then
        WScript.Echo "Argument <SpreadsheetName> required. For example:" _
                     & VbCrLf _
                     & "blah" 'fix
        Wscript.Quit(0)
    End If
    
    ' Bind to Excel object.
    On Error Resume Next
    Dim objExcel : Set objExcel = CreateObject("Excel.Application")
    If Err.Number <> 0 Then
        WScript.Echo "Excel application not found."
        Wscript.Quit
    End If
    On Error GoTo 0

    ' Open spreadsheet.
    On Error Resume Next
    objExcel.Workbooks.Add
    objExcel.Visible = True
    If Err.Number <> 0 Then
        On Error GoTo 0
        WScript.Echo "Spreadsheet cannot be opened: " & strExcelPath
        Wscript.Quit
    End If
    On Error GoTo 0
    
    Set SetupExcel = objExcel
End Function

Sub ExcelCleanUp(objExcel, strExcelPath)
	Dim objRange
	Set objRange = objExcel.ActiveWorkbook.Worksheets(1).UsedRange
	objRange.EntireColumn.Autofit()
    objExcel.ActiveWorkbook.SaveAs strExcelPath
    objExcel.Quit
End Sub

Thanks!
 
Sort by date Sort by votes
Do Until objExcludeFile.AtEndOfStream
This loop will only execute once. I'd load the emails into a dictionary, then check if the key exists.
 
Upvote 0 Downvote
Ok, so I have put in a dictionary, but am still not gettng what I need.

I need to search AD and before reporting out users, I need to check to see if that users email address is in a text file of names which need to be excluded. What I have here now will grab all the names in a file and put it in a dictionary. Now my issue is when it reports out from the loop, I get the same name multiple times. I need it to check the whole list/dictionary. If it finds a match, do not report it. If it does not find a match in the entire thing, then just report it once.

Code: 
Option Explicit

Dim objRootDSE, strDNSDomain, objCommand, objConnection
Dim strQuery, strBase, strFilter, strAttributes
Dim objRecordSet, strName, objUser, strParent, objParent
Dim strDN, strFirst, strLast, strEmail, strEmpID
Dim objFSO, objExcludeFile, strBadOU, strEmailCompare
Dim strPreferredEmail, objExcel, intRow, strExcelPath
Dim strExcludeFile, strExcludeFlag, strNextLine
Dim objDict, i, strLine

Const ForReading = 1, ForWriting = 2, ForAppending = 8

strBadOU = "test"
intRow = "1"
strExcelPath = "c:\OutPutFile.xls"
strExcludeFile = "c:\test.txt"

   Set objExcel = SetupExcel(strExcelPath)
   objExcel.Cells(intRow, 1).Value = "Name"
   objExcel.Cells(intRow, 2).Value = "First"
   objExcel.Cells(intRow, 3).Value = "Last"
   objExcel.Cells(intRow, 4).Value = "EmployeeID"
   objExcel.Cells(intRow, 5).Value = "Email"
   objExcel.Cells(intRow, 6).Value = "Preferred Email"
   objExcel.Rows(intRow).Interior.ColorIndex = 6
   objExcel.Rows(intRow).Font.Bold = True
   intRow = intRow + 1


Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objDict = CreateObject("Scripting.Dictionary")

If objFSO.FileExists(strExcludeFile) Then
Set objExcludeFile = objFSO.OpenTextFile("c:\test.txt", ForReading)
strExcludeFlag = True
Else
strExcludeFlag = False
End If

i = 0
Do Until objExcludeFile.AtEndofStream
strNextLine = objExcludeFile.ReadLine
If strNextLine <> "" And Not objDict.Exists(strNextLine) Then
objDict.Add i, strNextLine
End If
i = i + 1
Loop
objExcludeFile.Close

' Determine DNS domain name from RootDSE object.
Set objRootDSE = GetObject("LDAP://RootDSE")
strDNSDomain = objRootDSE.Get("defaultNamingContext")

' Use ADO to search Active Directory.
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection

' Search for all user objects. Return Values.
strBase = "<LDAP://" & strDNSDomain & ">"
strFilter = "(&(objectCategory=person)(objectClass=user)(homeMDB=*)(!userAccountControl:1.2.840.113556.1.4.803:=2))"
strAttributes = "displayName,distinguishedName,givenName,sn,employeeID,mail"
strQuery = strBase & ";" & strFilter & ";" & strAttributes & ";subtree"
objCommand.CommandText = strQuery
objCommand.Properties("Page Size") = 100
objCommand.Properties("Timeout") = 30
objCommand.Properties("Cache Results") = False
objCommand.Properties("Sort On") = "displayName"
Set objRecordSet = objCommand.Execute
  
    Do Until objRecordSet.EOF
  strName = objRecordSet.Fields("displayName")
  strDN = objRecordSet.Fields("distinguishedName")
  strFirst = objRecordSet.Fields("givenName")
  strLast = objRecordSet.Fields("sn")
  strEmpID = objRecordSet.Fields("employeeID")
  strEmail = objRecordSet.Fields("mail")

  Set objUser = GetObject("LDAP://" & strDN)
  strParent = objUser.Parent
  Set objParent = GetObject(strParent)

  strEmailCompare = Split(strEmail,"@")
  If strEmailCompare(0) <> strFirst Then
  strPreferredEmail = strEmailCompare(0)
  Else
  strPreferredEmail = ""
  End If
    
If objUser.AccountDisabled = False And Replace(objParent.Name,"CN=","") <> strBadOU And strExcludeFlag = True Then

	For Each strLine In objDict.Items
	If strNextLine <> strEmail Then
	                objExcel.Cells(intRow, 1).Value = strName
                    objExcel.Cells(intRow, 2).Value = strFirst
                    objExcel.Cells(intRow, 3).Value = strLast
                    objExcel.Cells(intRow, 4).Value = strEmpID
                    objExcel.Cells(intRow, 5).Value = strEmail
                    objExcel.Cells(intRow, 6).Value = strPreferredEmail
					intRow = intRow + 1
End If
Next
End If

    objRecordSet.MoveNext
	Loop

objConnection.Close

Call ExcelCleanUp(objExcel, strExcelPath)

Function SetupExcel(strExcelPath)
    WScript.Echo strExcelPath
    
    ' Check for required arguments.
    If Not strExcelPath <> "" Then
        WScript.Echo "Argument <SpreadsheetName> required."
        Wscript.Quit(0)
    End If
    
    ' Bind to Excel object.
    On Error Resume Next
    Dim objExcel : Set objExcel = CreateObject("Excel.Application")
    If Err.Number <> 0 Then
        WScript.Echo "Excel application not found."
        Wscript.Quit
    End If
    On Error GoTo 0

    ' Open spreadsheet.
    On Error Resume Next
    objExcel.Workbooks.Add
    objExcel.Visible = True
    If Err.Number <> 0 Then
        On Error GoTo 0
        WScript.Echo "Spreadsheet cannot be opened: " & strExcelPath
        Wscript.Quit
    End If
    On Error GoTo 0
    
    Set SetupExcel = objExcel
End Function

Sub ExcelCleanUp(objExcel, strExcelPath)
	Dim objRange
	Set objRange = objExcel.ActiveWorkbook.Worksheets(1).UsedRange
	objRange.EntireColumn.Autofit()
    objExcel.ActiveWorkbook.SaveAs strExcelPath
    objExcel.Quit
End Sub
 
Upvote 0 Downvote
>Replace(objParent.Name,"CN=","") <> strBadOU
If objParent is an ou, why do you compare name with "CN=" replaced? It is "OU=".
 
Upvote 0 Downvote
Thanks. I did not catch that. I fixed it now but I won't repost it for that.
 
Upvote 0 Downvote
[1]
[tt]If objFSO.FileExists(strExcludeFile) Then
[red]'[/red]Set objExcludeFile = objFSO.OpenTextFile("c:\test.txt", ForReading)
strExcludeFlag = True
Else
strExcludeFlag = False
End If

[blue]if strExcludeFlag then[/blue]
i = 0
[blue]Set objExcludeFile = objFSO.OpenTextFile("c:\test.txt", ForReading)[/blue]
Do Until objExcludeFile.AtEndofStream
strNextLine = objExcludeFile.ReadLine
If strNextLine <> "" And Not objDict.Exists(strNextLine) Then
objDict.Add [red]strNextLine, i[/red]
End If
i = i + 1
Loop
objExcludeFile.Close
[blue]end if[/blue]
[/tt]
[2]
[tt]
[red]'[/red]For Each strLine In objDict.Items
[red]'[/red]If strNextLine <> strEmail Then
[red]if not objDict.Exists(strEmail)[/red]
objExcel.Cells(intRow, 1).Value = strName
objExcel.Cells(intRow, 2).Value = strFirst
objExcel.Cells(intRow, 3).Value = strLast
objExcel.Cells(intRow, 4).Value = strEmpID
objExcel.Cells(intRow, 5).Value = strEmail
objExcel.Cells(intRow, 6).Value = strPreferredEmail
intRow = intRow + 1
End If
[red]'[/red]Next
[/tt]
 
Upvote 0 Downvote
Amendment
The corresponding line in [2] should be read.
[tt] if not objDict.Exists(strEmail) [red]then[/red][/tt]
 
Upvote 0 Downvote
Status
Not open for further replies.

Similar threads

GessWurker1
  • Locked
  • Question
problem with AD query, empty values and form field population
Replies
0
Views
131
GessWurker1
GessWurker1
Don Child
  • Locked
  • Question
Can open a link in a browser no problem, but code returns 302
Replies
0
Views
121
Don Child
Don Child
GooberBoy3017
  • Locked
  • Question
VBScript problem upgrading from WIn7 to Win10 (Enterprise)
Replies
3
Views
151
strongm
strongm
aiqin
  • Locked
  • Question
Why the loop can not be executed for the 2nd time? 1
Replies
5
Views
81
aiqin
aiqin
TampaRocks
  • Locked
  • Question
Loop with an array? 2
Replies
11
Views
139
TampaRocks
TampaRocks

Part and Inventory Search

Sponsor

Back
Top