stepping down rows

  • Thread starter Thread starter JasonMeyer
  • Start date Start date
J

JasonMeyer

Can some one give a newbie some pointers on how to step down a row until it
hits a blank row?

Basically I don't know how many rows there will be but I want it to read the
row...do some work....step to the next row....read the row....do some
work....etc. I can get it to read the row....do some work.....but I can't
get it to step to the next row.

TIA

Jason
 
Jason,

Try something like the following:

Dim Rng As Range
Set Rng = Range("A1") 'first cell
Do Until Rng.Value = ""
Set Rng = Rng(2, 1)
Loop
Debug.Print "Empty cell: " & Rng.Address

--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
 
OK I guess I am a bigger noob than I expected and am not seeing how to work
that into my script(actually some one elses that I have been modding to
better suite my needs)...Care to take a look at the script itself and make
suggestions from there?

Jason
 
Jason,

Post the code you are using an indicate what sections you need
help with.


--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com
 
OK here it goes....This is something I found to create a user in AD and
enable and e2k mailbox...I have made some small changes to read the excel
file differently and added a bunch of logic when creating ldap pathes and
stuff but I wouldn't think that would prevent it from looping thru until it
finds the end. When I run this it basically never steps to the next
row....As you can probably tell this is a wsh script that I plan on running
from a cmd prompt on a schedule.

Look for the <------ bit to see what I have said.


Thanks for the help.

Jason

<package>
<reference object="ActiveDs.IADsContainer"/>
<reference object="ActiveDs.IADsUser"/>
<reference object="MSIMADMLib.IMServers"/>
<reference object="MSIMADMLib.IMVirtualServer"/>
<reference object="MSIMADMLib.IMUserAdmin"/>
<reference object="MSIMADMLib.IIMUser"/>
<reference object="CDO.Person"/>
<reference object="CDOEXM.ExchangeServer"/>
<reference object="CDOEXM.IMailboxStore"/>
<reference object="CDOEXM.IMailRecipient"/>
<reference object="CDOEXM.IDataSource2"/>
<reference object="Excel.Application"/>
<Job id="BulkAddFromExcel">
<script language="VBScript">

'THIS CODE AND INFORMATION IS PROVIDED "AS IS" WITHOUT
'WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
'INCLUDING BUT NOT LIMITED TO THE IMPLIED WARRANTIES
'OF MERCHANTABILITY AND/OR FITNESS FOR A PARTICULAR
'PURPOSE
'
' You are free to use this code within your own applications,
' but you are expressly forbidden from selling or otherwise
' distributing this source code without prior written consent.
' This includes both posting free demo projects made from this
' code as well as reproducing the code in any other format.
'
'---------------------------------------------------------------------------
---
'
' NAME: BulkAddFromExcel.wsf
'
' FILE DESCRIPTION: This Windows Script File creates new user objects in
' Active Directory from an Excel Spreadsheet using Active
' Directory Services Interface (aka ADSI)
' After they are created, CDO for Exchange 2000 (aka
CDOEXM)
' is used to mailbox enable each user object
' Finally the Exchange Instant Messaging Administration
Library
' is used to IM enable each user object
'
' Note that the Lightweight Directory Access Protocol
(LDAP)
' requires that you escape the following characters with a
backslash
' (\) character when you use them in Active Directory:
' ,=+<>#;\"
'
' Copyright (c) CDOLive 2000-2001, Siegfried Weber. All rights reserved.
' http://www.cdolive.net/samples/adusermanagement.eml
' mailto:[email protected]?subject=ADUserManagement

' With contributions by (in alphabetical order):
' Sjaak van der Poel, (e-mail address removed)
'
' Portions:
' Copyright (c) Microsoft Corporation 1996. All rights reserved.
'
'---------------------------------------------------------------------------
---

' Initialize error handling
Option Explicit
On Error Resume Next

' Declare variables
Dim objArguments ' As Wscript.Arguments
Dim objContainer ' As ActiveDs.IADsContainer
Dim objUser ' As ActiveDs.IADsUser
Dim objIMServers ' As MSIMADMLib.IMServers
Dim objIMVirtualServer ' As MSIMADMLib.IMVirtualServer
Dim objIMUserAdmin ' As MSIMADMLib.IMUserAdmin
Dim objIMUser ' As MSIMADMLib.IIMUser
Dim objPerson ' As CDO.Person
Dim objExchangeServer ' As CDOEXM.ExchangeServer
Dim objMailboxStore ' As CDOEXM.IMailboxStore
Dim objRecipient ' As CDOEXM.IMailRecipient
Dim objDataSource ' As CDOEXM.IDataSource2
Dim objExcel ' As Excel.Application
Dim strCRLF ' As String
Dim strExcelWorkBook ' As String
Dim strLDAP ' As String
Dim strRoot ' As String
Dim strOU ' As String
Dim strBuilding ' As String
Dim strUserName ' As String
Dim strSamName ' As String
Dim strDisplayName ' As String
Dim strAlias ' As String
Dim strHomeMDBUrl ' As String
Dim strPersonURL ' As String
Dim blnExcelInstalled ' As Boolean
Dim blnCDOInstalled ' As Boolean
Dim blnCDOEXMInstalled ' As Boolean
Dim blnLDAPConnect ' As Boolean
Dim varProxyAddresses(10) ' As Variant

' Initialize variables
Set objExchangeServer = Nothing
Set objExcel = Nothing
Set objIMServers = Nothing
Set objIMVirtualServer = Nothing
Set objIMUserAdmin = Nothing
Set objPerson = Nothing
Set objMailboxStore = Nothing
Set objRecipient = Nothing
Set objDataSource = Nothing
strCRLF = Chr(13) & Chr(10)
blnExcelInstalled = False
blnLDAPConnect = False
blnExcelInstalled = False
blnCDOInstalled = False
blnCDOEXMInstalled = False

' Get the script command line arguments
Set objArguments = WScript.Arguments

' Excel file containing users is the first (and only valid) argument
If objArguments.Count <> 0 Then
strExcelWorkBook = objArguments.Item(0)
End If

' Check if first comannd line argument isn't empty
If strExcelWorkBook = "" Then
WScript.Echo "No input file provided. Script execution terminated. Please
make sure you provide a valid Excel file as input."
Else

' Check if necessary objects are installed by simply create an instance of
each
Err.Clear
Set objExcel = WScript.CreateObject("Excel.Application")
If Err.Number = 0 Then
blnExcelInstalled = True
End If
Err.Clear
Set objPerson = CreateObject("CDO.Person")
If Err.Number = 0 Then
blnCDOInstalled = True
End If
Err.Clear
Set objExchangeServer = CreateObject("CDOEXM.ExchangeServer")
If Err.Number = 0 Then
blnCDOEXMInstalled = True
End If

' Check if required components are installed
If (blnExcelInstalled = False Or blnCDOInstalled = False Or
blnCDOEXMInstalled = False) Then

' Display error message
WScript.Echo "One of the required components could not be started. Please
make sure the machine is running the following software: " & _
strCRLF & " Microsoft Windows 2000 (or higher) Server or
Professional" & _
strCRLF & " Microsoft Winodws 2000 (or higher) Administrative
Tools (a separate install if running on Windows 2000 Professional)" & _
strCRLF & " Microsoft Exchange 2000 (or higher) System Manager"
& _
strCRLF & " Microsoft Excel 2000 (or higher)"
Else

' Initialize other objects
Set objIMServers = CreateObject("MSExchangeIM.IMServers.1")
Set objIMVirtualServer = CreateObject("MSExchangeIM.IMVirtualServer.1")
Set objIMUserAdmin = CreateObject("MSExchangeIM.IMUserAdmin.1")
Set objMailboxStore = objPerson.GetInterface("IMailboxStore")
Set objRecipient = objPerson.GetInterface("IMailRecipient")
Set objDataSource = objPerson.GetInterface("IDatasource")

' We will use strbuilding to control loop, so set initial value to null
strbuilding = ""

' Activate Excel
With objExcel

' Open the workbook passed in the command line
Err.Clear
.Workbooks.open strExcelWorkBook

' Check for errors
If Err.Number = 0 Then

' Activate it
blnExcelInstalled = True
.Sheets("Add").Activate

' Put the cursor in the starting cell and read the DS root
.ActiveSheet.Range("A2").Activate
'This cell holds the building label
strBuilding = .Activecell.Value


' This is the starting point in the ds
'Hard set by me as A2 is not the DS root in the file from skyward.
strRoot = "dc=ad,dc=roseville,dc=k12,dc=mn,dc=us"

' Step to the next row
.Activecell.Offset(1, 0).Activate
Else

' Display error message
WScript.Echo "Error opening Excel workbook. Check if Excel is installed
and the file is not readonly " & Err.Number & Err.Description
blnExcelInstalled = False
End If
End With

' Check if Excel could be opened
If blnExcelInstalled = True Then

' Loop until we run out of rows
Do While objExcel.Activecell.Value <> "" <-------start of the loop.
Should be using strbuilding to control things.

' If the requested OU is a new one...
If objExcel.Activecell.Value <> strbuilding Then

' Build path to OU and HomeMDBUrl based on what strBuilding is set to.
msgBox "here:" & strBuilding
If strBuilding = "RAHS" then
strOU="OU=RAHS,OU=staff,OU=secondary"
strHomeMDBUrl = "CN=SecondaryMailboxes,CN=Second Storage
Group,CN=InformationStore,CN=rosemail,CN=Servers,CN=First Administrative
Group,CN=Administrative Groups,CN=rosemain,CN=Microsoft
Exchange,CN=Services,CN=Configuration," & strRoot

ElseIf strBuilding = "RAMS" then
strOU="OU=RAMS,OU=staff,OU=secondary"
strHomeMDBUrl = "CN=SecondaryMailboxes,CN=Second Storage
Group,CN=InformationStore,CN=rosemail,CN=Servers,CN=First Administrative
Group,CN=Administrative Groups,CN=rosemain,CN=Microsoft
Exchange,CN=Services,CN=Configuration," & strRoot

ElseIf strBuilding = "PCS" then
strOU="OU=PCS,OU=staff,OU=secondary"
strHomeMDBUrl = "CN=SecondaryMailboxes,CN=Second Storage
Group,CN=InformationStore,CN=rosemail,CN=Servers,CN=First Administrative
Group,CN=Administrative Groups,CN=rosemain,CN=Microsoft
Exchange,CN=Services,CN=Configuration," & strRoot

ElseIf strBuilding = "BH" then
strOU="OU=BH,OU=staff,OU=primary"
strHomeMDBUrl = "CN=PrimaryMailboxes,CN=Second Storage
Group,CN=InformationStore,CN=rosemail,CN=Servers,CN=First Administrative
Group,CN=Administrative Groups,CN=rosemain,CN=Microsoft
Exchange,CN=Services,CN=Configuration," & strRoot

Elseif strBuilding = "CP" then
strOU="OU=CP,OU=staff,OU=primary"
strHomeMDBUrl = "CN=PrimaryMailboxes,CN=Second Storage
Group,CN=InformationStore,CN=rosemail,CN=Servers,CN=First Administrative
Group,CN=Administrative Groups,CN=rosemain,CN=Microsoft
Exchange,CN=Services,CN=Configuration," & strRoot

ElseIf strBuilding = "EDG" then
strOU="OU=EDG,OU=staff,OU=primary"
strHomeMDBUrl = "CN=PrimaryMailboxes,CN=Second Storage
Group,CN=InformationStore,CN=rosemail,CN=Servers,CN=First Administrative
Group,CN=Administrative Groups,CN=rosemain,CN=Microsoft
Exchange,CN=Services,CN=Configuration," & strRoot

ElseIf strBuilding = "EDW" then
strOU="OU=EDW,OU=staff,OU=primary"
strHomeMDBUrl = "CN=PrimaryMailboxes,CN=Second Storage
Group,CN=InformationStore,CN=rosemail,CN=Servers,CN=First Administrative
Group,CN=Administrative Groups,CN=rosemain,CN=Microsoft
Exchange,CN=Services,CN=Configuration," & strRoot

ElseIf strBuilding = "FH" then
strOU="OU=EDW,OU=staff,OU=primary"
strHomeMDBUrl = "CN=PrimaryMailboxes,CN=Second Storage
Group,CN=InformationStore,CN=rosemail,CN=Servers,CN=First Administrative
Group,CN=Administrative Groups,CN=rosemain,CN=Microsoft
Exchange,CN=Services,CN=Configuration," & strRoot

ElseIf strBuilding = "LC" then
strOU="OU=LC,OU=staff,OU=primary"
strHomeMDBUrl = "CN=PrimaryMailboxes,CN=Second Storage
Group,CN=InformationStore,CN=rosemail,CN=Servers,CN=First Administrative
Group,CN=Administrative Groups,CN=rosemain,CN=Microsoft
Exchange,CN=Services,CN=Configuration," & strRoot

ElseIf strBuilding = "DC" then
strOU="OU=DC,ou=District"
strHomeMDBUrl = "CN=Mailbox Store (RoseMail),CN=First Storage
Group,CN=InformationStore,CN=rosemail,CN=Servers,CN=First Administrative
Group,CN=Administrative Groups,CN=rosemain,CN=Microsoft
Exchange,CN=Services,CN=Configuration," & strRoot

ElseIf strBuilding = "FVCC" then
strOU="OU=FVCC,OU=District"
strHomeMDBUrl = "CN=Mailbox Store (RoseMail),CN=First Storage
Group,CN=InformationStore,CN=rosemail,CN=Servers,CN=First Administrative
Group,CN=Administrative Groups,CN=rosemain,CN=Microsoft
Exchange,CN=Services,CN=Configuration," & strRoot

End If
'This is where my mod ends

' Compose the LDAP path
strLDAP = "LDAP://" + strOU + "," + strRoot

' Show it to the user
WScript.Echo "Processing entries for: " + strLDAP

' And get the object
Err.Clear
Set objContainer = GetObject(strLDAP)

' Check for errors
If Err.Number <> 0 Then

' Display error message
WScript.Echo "Error retrieving Active Directory settings. Please check
if the provided LDAP string is correct " & Err.Number & Err.Description
Else
blnLDAPConnect = True
End If
End If

' Check if we could connect to AD
If blnLDAPConnect = True Then
objExcel.ActiveSheet.Range("A2").Activate
' Compose the user common name name from last and first name
strUserName = "CN=" + objExcel.activecell.offset(0, 3).Value + "\, " +
objExcel.activecell.offset(0, 2).Value

' Compose the user display name from first and last names
strDisplayName = objExcel.Activecell.Offset(0, 3).Value & ", " &
objExcel.Activecell.Offset(0, 2).Value

' Compose the user Instant Messaging alias name from first and last
names

'strAlias = Left(LCase(Left(objExcel.Activecell.Offset(0, 3).Value, 1)
+ objExcel.Activecell.Offset(0, 2).Value), 20)

' Show to user that we now create a new object
WScript.Echo "Processing entry: " + strDisplayName

' Create the new user object
Err.Clear
Set objUser = objContainer.Create("user", strUserName)

' Check for errors
If Err.Number = 0 Then

' Set the properties of the new user. This is the part that is broken.
Need to get a better file and know
' exactly where the first active cell is, that way we can make sure
that the offsets are used correctly.
With objUser

' First name
If Trim(objExcel.Activecell.Offset(0, 2).Value) <> "" Then
.Put "givenName", CStr(objExcel.Activecell.Offset(0, 2).Value)
End If

' Last name
If Trim(objExcel.Activecell.Offset(0, 3).Value) <> "" Then
.Put "sn", CStr(objExcel.Activecell.Offset(0, 3).Value)
End If

' Display name
If Trim(strDisplayName) <> "" Then
.Put "displayName", strDisplayName
End If

' Pre-Windows 2000 account name
If Trim(objExcel.Activecell.Offset(0, 1).Value) <> "" Then
.Put "sAMAccountName", Left(CStr(objExcel.Activecell.Offset(0,
1).Value), 20)
End If

' Windows 2000 UPN (user principale name)
If Trim(objExcel.Activecell.Offset(0, 1).Value) <> "" Then
.Put "userPrincipalName", CStr(objExcel.Activecell.Offset(0,
1).Value)
End If

' Phone number
If Trim(objExcel.Activecell.Offset(0, 8).Value) <> "" Then
.Put "telephoneNumber", CStr(objExcel.Activecell.Offset(0, 8).Value)
End If

' Fax number
'If Trim(objExcel.Activecell.Offset(0, 6).Value) <> "" Then
' .Put "facsimileTelephoneNumber", CStr(objExcel.Activecell.Offset(0,
6).Value)
'End If

' Cell phone number
'If Trim(objExcel.Activecell.Offset(0, 7).Value) <> "" Then
' .Put "mobile", CStr(objExcel.Activecell.Offset(0, 7).Value)
'End If

' Home phone number
If Trim(objExcel.Activecell.Offset(0, 9).Value) <> "" Then
.Put "homePhone", CStr(objExcel.Activecell.Offset(0, 9).Value)
End If

' ZIP/Postal code
If Trim(objExcel.Activecell.Offset(0, 7).Value) <> "" Then
.Put "postalCode", CStr(objExcel.Activecell.Offset(0, 7).Value)
End If

' Street
If Trim(objExcel.Activecell.Offset(0, 5).Value) <> "" Then
.Put "streetAddress", CStr(objExcel.Activecell.Offset(0, 5).Value)
End If

' City
If Trim(objExcel.Activecell.Offset(0, 7).Value) <> "" Then
.Put "l", CStr(objExcel.Activecell.Offset(0, 7).Value)
End If

' P.O. Box
'If Trim(objExcel.Activecell.Offset(0, 12).Value) <> "" Then
' .Put "postOfficeBox", CStr(objExcel.Activecell.Offset(0, 12).Value)
'End If

' State/Province
If Trim(objExcel.Activecell.Offset(0, 8).Value) <> "" Then
.Put "st", CStr(objExcel.Activecell.Offset(0, 8).Value)
End If

' Country code
'If Trim(objExcel.Activecell.Offset(0, 14).Value) <> "" Then
' .Put "c", CStr(objExcel.Activecell.Offset(0, 14).Value)
'End If

' Department
'If Trim(objExcel.Activecell.Offset(0, 15).Value) <> "" Then
' .Put "department", CStr(objExcel.Activecell.Offset(0, 15).Value)
'End If

' Company
'If Trim(objExcel.Activecell.Offset(0, 16).Value) <> "" Then
' .Put "company", CStr(objExcel.Activecell.Offset(0, 16).Value)
'End If

' Title
'If Trim(objExcel.Activecell.Offset(0, 17).Value) <> "" Then
' .Put "title", CStr(objExcel.Activecell.Offset(0, 17).Value)
'End If

' Pager
'If Trim(objExcel.Activecell.Offset(0, 18).Value) <> "" Then
' .Put "pager", CStr(objExcel.Activecell.Offset(0, 18).Value)
'End If

' Webpage URL
'If Trim(objExcel.Activecell.Offset(0, 19).Value) <> "" Then
' .Put "wWWHomePage", CStr(objExcel.Activecell.Offset(0, 19).Value)
'End If

' Office
'If Trim(objExcel.Activecell.Offset(0, 20).Value) <> "" Then
' .Put "physicalDeliveryOfficeName",
CStr(objExcel.Activecell.Offset(0, 20).Value)
'End If

' Description
'If Trim(objExcel.Activecell.Offset(0, 21).Value) <> "" Then
' .Put "description", CStr(objExcel.Activecell.Offset(0, 21).Value)
'End If

' HomeDrive
'If Trim(objExcel.Activecell.Offset(0, 39).Value) <> "" Then
' .Put "homeDrive", CStr(objExcel.Activecell.Offset(0, 39).Value)
'End If

' homeDirectory
'If Trim(objExcel.Activecell.Offset(0, 40).Value) <> "" Then
' .Put "homeDirectory", CStr(objExcel.Activecell.Offset(0, 40).Value)
'End If

' scriptPath
'If Trim(objExcel.Activecell.Offset(0, 41).Value) <> "" Then
' .Put "scriptPath", CStr(objExcel.Activecell.Offset(0, 41).Value)
'End If

' ProfilePath
'If Trim(objExcel.Activecell.Offset(0, 42).Value) <> "" Then
' .Put "ProfilePath", CStr(objExcel.Activecell.Offset(0, 42).Value)
'End If

' Save data
Err.Clear
.SetInfo

' Check for errors
If Err.Number <> 0 Then

' Display error message
WScript.Echo "Error setting user properties " & Err.Number &
Err.Description
End If

End With

' Set password and enable account
With objUser


' Set password and enable the account
If Trim(objExcel.Activecell.Offset(0, 1).Value) <> "" Then
.SetPassword objExcel.Activecell.Offset(0, 1).Value
End If
.AccountDisabled = False

' Save data
Err.Clear
.SetInfo

' Check for errors
If Err.Number <> 0 Then

' Display error message
WScript.Echo "Error setting user properties " & Err.Number &
Err.Description
End If
End With
'enable mailbox for user
If Trim(strUserName) <> "" Then

' Construct LDAP URL to AD object
strPersonURL = "LDAP://" + strUserName + "," + strOU + "," + strRoot

' Open user object with CDO for Exchange 2000
Set objPerson = CreateObject("CDO.Person")
Set objDataSource = objPerson.GetInterface("IDataSource")
Err.Clear
objDataSource.Open strPersonURL

' Check for errors
If Err.Number = 0 Then
Set objMailboxStore = objPerson.GetInterface("IMailboxStore")
Set objRecipient = objPerson.GetInterface("IMailRecipient")
If Trim(strHomeMDBUrl) <> "" Then

' Set Exchange 2000 Server mailbox home database property
objMailboxStore.CreateMailbox strHomeMDBUrl


End If

' Save data
Err.Clear
objPerson.DataSource.Save
End If
End If

' Tidy up
strHomeMDBUrl = ""
strPersonURL = ""
Set objUser = Nothing
Set objPerson = Nothing
End If

' Step to the next user
objExcel.Activecell.Offset(1, 0).Activate <------- doesn't seem to be
doing this
Else

' Exit loop
Exit Do
End If
Loop

' Close Excel spreadsheet
objExcel.Application.Quit
End If
End If
End If

' Tidy up
Set objArguments = Nothing
Set objExchangeServer = Nothing
Set objUser = Nothing
Set objContainer = Nothing
Set objExcel = Nothing
Set objIMServers = Nothing
Set objIMVirtualServer = Nothing
Set objIMUserAdmin = Nothing
Set objPerson = Nothing
Set objMailboxStore = Nothing
Set objRecipient = Nothing
Set objDataSource = Nothing

' Show to user
WScript.Echo "Finished running script."

</script>
</Job>
</package>
 
Back
Top