Link to home
Start Free TrialLog in
Avatar of JB4375
JB4375Flag for United States of America

asked on

VBScript: Output to Excel Leaves Blank Rows The Spreadsheet.

I'm searching Active Directory and eliminating unwanted accounts by filters. The problem is that everytime it encounters one of the records I don't want, it leaves a blank row on the spreadsheet. I could easily sort and remove all the blanks rows after the fact, but I'd rather have them not there in the first place.


On Error Resume Next

' Excel Spreadsheet Setup
Set Excel = CreateObject("Excel.Application")
Excel.Visible = True
Excel.Workbooks.Add

' Setup Column Headings
Excel.Cells(1, 1).Value = "User ID"
Excel.Cells(1, 2).Value = "Full Name"
Excel.Cells(1, 3).Value = "Description"
Excel.Cells(1, 4).Value = "Email Address"
Excel.Cells(1, 5).Value = "Employee Type"
'Excel.Cells(1, 9).Value = "OU Location"

' Setup Column Widths
Excel.Columns(1).ColumnWidth = 12
Excel.Columns(2).ColumnWidth = 20
Excel.Columns(3).ColumnWidth = 30
Excel.Columns(4).ColumnWidth = 30
Excel.Columns(5).ColumnWidth = 20
'Excel.Columns(9).ColumnWidth = 75

' Setup Spreadsheet Range and Top Row
Excel.Range("A1:E1").Select
Excel.Selection.Font.Bold = True
Excel.Selection.Interior.ColorIndex = 1 'Black
Excel.Selection.Interior.Pattern = 1 'xlSolid
Excel.Selection.Font.ColorIndex = 44 'Gold

' Set Range to Freeze Top Row
Excel.Range("A2").Select
Excel.Activewindow.FreezePanes = True

counter = 2 'init to second cell


' Reference Section
Set objCommand = CreateObject("ADODB.Command")
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000

Set objNameExcludes = CreateObject("Scripting.Dictionary")
objNameExcludes.Add "1", 0
objNameExcludes.Add "2", 0
objNameExcludes.Add "3", 0
objNameExcludes.Add "4", 0
objNameExcludes.Add "5", 0
objNameExcludes.Add "6", 0
objNameExcludes.Add "7", 0
objNameExcludes.Add "8", 0
objNameExcludes.Add "9", 0
objNameExcludes.Add "0", 0
objNameExcludes.Add "_", 0

' Worker Section
strDomain = "ou=domain,dc=com"
strFilter = "(&(objectCategory=User)(cn=*))"
strAttributes = "DistinguishedName,Name"
strQuery = "<LDAP://" & strDomain & ">;" & strFilter & ";" & strAttributes & ";DistinguishedName,Name,GivenName,SN;Subtree"

objCommand.CommandText = strQuery
Set objRecordSet = objCommand.Execute

Do Until objRecordSet.EOF   
 
  strLocation = objRecordSet.Fields("DistinguishedName")
  Set objUser = GetObject("LDAP://mdc1/" & strLocation)   
  
  strOU = Split(strLocation,",")
  
  ' Retrieve userAccountControl value.
  lngFlag = objUser.userAccountControl
    
    ' This For/Next loop determines your OU
    For i = LBound(strOU) To UBound(strOU)
      If InStr(strOU(i), "_") Or InStr(strOU(i), "-") > 0 Then
        strOrgUnit = mid(strOU(i), 4)
      Else
      End If
    Next
    
'  '******   Remove Unwanted Service Accounts 
	bSkip = False					
         For Each strExclude In objNameExcludes
	   If InStr(LCase(objUser.sAMAccountname), LCase(strExclude)) > 0 Then
		bSkip = True					
                  Exit For
	    End If
	Next

	If bSkip = False Then 'add the record, otherwise if bSkip is true, this block will not be executed
							
          ' The next 2 lines determine the object's group membership
	 Set objUser = GetObject("LDAP://" & strLocation )    
	 objMemberOf = objUser.GetEx("MemberOf")
						    
	     Excel.Cells(Counter,1).Value = objUser.sAMAccountname
	     Excel.Cells(Counter,2).Value = objUser.DisplayName
	     Excel.Cells(Counter,3).Value = objUser.Description
	     Excel.Cells(Counter,4).Value = objUser.Mail
	     Excel.Cells(Counter,5).Value = objUser.EmployeeType

          End If
		   
	  objRecordSet.MoveNext
	  Counter = Counter + 1  
Loop

objConnection.Close

Open in new window

ASKER CERTIFIED SOLUTION
Avatar of jeffmowens
jeffmowens
Flag of United States of America image

Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Avatar of JB4375

ASKER

LOL.
These loops always give me so much grief.
Thanks!!