Why Experts Exchange?

Experts Exchange always has the answer, or at the least points me in the correct direction! It is like having another employee that is extremely experienced.

Jim Murphy
Programmer at Smart IT Solutions

When asked, what has been your best career decision?

Deciding to stick with EE.

Mohamed Asif
Technical Department Head

Being involved with EE helped me to grow personally and professionally.

Carl Webster
CTP, Sr Infrastructure Consultant
Ask ANY Question

Connect with Certified Experts to gain insight and support on specific technology challenges including:

Professional Opinions
Ask a Question
Did You Know?

We've partnered with two important charities to provide clean water and computer science education to those who need it most. READ MORE

troubleshooting Question

VBScript: Output to Excel Leaves Blank Rows The Spreadsheet.

Avatar of JB4375
JB4375Flag for United States of America asked on
VB Script
2 Comments1 Solution510 ViewsLast Modified:
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

' 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.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.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)
      End If
'  '******   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

	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
	  Counter = Counter + 1  

Avatar of jeffmowens
jeffmowensFlag of United States of America image

Our community of experts have been thoroughly vetted for their expertise and industry experience.

This problem has been solved!
Unlock 1 Answer and 2 Comments.
See Answers