Not enough storage while running vb script

Tech-Archive recommends: Fix windows errors by optimizing your registry

CScript Error: Execution of the Windows Script Host failed. (Not enough
storage is available to complete this operation. )

Here is the script:

' UpdateUserProfile2.vbs
' VBScript program to update the profilePath attribute of user objects
' according to the information in a spread***.
'
'
----------------------------------------------------------------------
' Copyright (c) 2004 Richard L. Mueller
' Hilltop Lab web site - http://www.rlmueller.net
' Version 1.0 - January 13, 2004
' Version 1.1 - January 25, 2004 - Modify error trapping.
' Version 1.2 - March 18, 2004 - Modify NameTranslate constants.
'
' The input spread*** is a list of the NT logon name of each user
' whose profilePath attribute will be updated, one name per row. The
' user names are in the first column. The value to be assigned to the
' profilePath attribute is in the second column. The first row is
' skipped. The program processes each row until a blank entry is
' encountered in the first column. If the entry in the second column is
' the special value ".delete", the program will clear the profilePath
' attribute for that user. The program uses the NameTranslate object to
' convert the NT name of the user (the sAMAccountName attribute) to
the
' Distinguished Name required to bind to the user object with the LDAP
' provider.
'
' You have a royalty-free right to use, modify, reproduce, and
' distribute this script file in any way you find useful, provided that
' you agree that the copyright owner above has no warranty,
obligations,
' or liability for such use.

Option Explicit

Const ADS_PROPERTY_CLEAR = 1
Const ADS_NAME_INITTYPE_GC = 3
Const ADS_NAME_TYPE_NT4 = 3
Const ADS_NAME_TYPE_1779 = 1

Dim strExcelPath, objExcel, obj***, intRow, strUserDN, strProfilePath
Dim objUser, strUserNTName
Dim objRootDSE, strDNSDomain, objTrans, strNetBIOSDomain
Dim strdisplayName, strdepartment, strmailNickname,
strfacsimileTelephoneNumber
Dim strgivenName, strinitials, strsn, strtelephoneNumber, strtitle,
strphysicalDeliveryOfficeName

' Check for required arguments.
If Wscript.Arguments.Count < 1 Then
Wscript.Echo "Argument <SpreadsheetName> required. For example:" _
& vbCrLf _
& "cscript UpdateUserProfile2.vbs c:\MyFolder\UserList.xls"
Wscript.Quit(0)
End If

' Spread*** file.
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
On Error GoTo 0

' Open spread***.
On Error Resume Next
objExcel.Workbooks.Open strExcelPath
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Spread*** cannot be opened: " & strExcelPath
Wscript.Quit
End If
On Error GoTo 0

' Bind to work***.
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)

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

' Use the NameTranslate object to find the NetBIOS domain name
' from the DNS domain name.
Set objTrans = CreateObject("NameTranslate")
objTrans.Init ADS_NAME_INITTYPE_GC, ""
objTrans.Set ADS_NAME_TYPE_1779, strDNSDomain
strNetBIOSDomain = objTrans.Get(ADS_NAME_TYPE_NT4)
' Remove trailing backslash.
strNetBIOSDomain = Left(strNetBIOSDomain, _
Len(strNetBIOSDomain) - 1)

' The first row of the spread*** is skipped (column headings). Each
' row after the first is processed until the first blank entry in the
' first column is encountered. The first column is the NT user name of
' the user, the second column is the new profilePath. The loop binds to
' each user object and assigns the new value for the attribute. intRow
' is the row number of the spread***.
' Use the NameTranslate object to convert the NT user names
' to the Distinguished Name required for the LDAP provider.
intRow = 2
Do While obj***.Cells(intRow, 1).Value <> ""
strUserNTName = Trim(obj***.Cells(intRow, 1).Value)
' Use NameTranslate to convert NT name to Distinguished Name.
On Error Resume Next
objTrans.Set ADS_NAME_TYPE_NT4, strNetBIOSDomain & "\" &
strUserNTName
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "User " & strUserNTName _
& " not found in Active Directory"
End If
On Error GoTo 0
strUserDN = objTrans.Get(ADS_NAME_TYPE_1779)
strdisplayName = Trim(obj***.Cells(intRow, 2).Value)
strdepartment = Trim(obj***.Cells(intRow, 3).Value)
strmailNickname = Trim(obj***.Cells(intRow, 4).Value)
strfacsimileTelephoneNumber = Trim(obj***.Cells(intRow, 5).Value)
strgivenName = Trim(obj***.Cells(intRow, 6).Value)
strinitials = Trim(obj***.Cells(intRow, 7).Value)
strsn = Trim(obj***.Cells(intRow, 8).Value)
strtelephoneNumber = Trim(obj***.Cells(intRow, 9).Value)
strtitle = Trim(obj***.Cells(intRow, 10).Value)
strphysicalDeliveryOfficeName = Trim(obj***.Cells(intRow,
11).Value)

If strdisplayName = "" Then
On Error GoTo 0
Wscript.Echo "Skipped - field was blank"
End If
If LCase(strdisplayName) = ".delete" Then
On Error Resume Next
objUser.PutEx ADS_PROPERTY_CLEAR, "displayName", 0
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to clear displayName for user " _
& strUserDN
End If
On Error GoTo 0
Else
objUser.displayname = strdisplayName
On Error Resume Next
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to set displayName for user " _
& strUserDN
End If
On Error GoTo 0
End If

If strdepartment = "" Then
On Error GoTo 0
Wscript.Echo "Skipped - field was blank"
End If
If LCase(strdepartment) = ".delete" Then
On Error Resume Next
objUser.PutEx ADS_PROPERTY_CLEAR, "department", 0
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to clear department for user " _
& strUserDN
End If
On Error GoTo 0
Else
objUser.department = strdepartment
On Error Resume Next
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to set department for user " _
& strUserDN
End If
On Error GoTo 0
End If

If strmailNickname = "" Then
On Error GoTo 0
Wscript.Echo "Skipped - field was blank"
End If
If LCase(strmailNickname) = ".delete" Then
On Error Resume Next
objUser.PutEx ADS_PROPERTY_CLEAR, "mailNickName", 0
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to clear MailNickName for user " _
& strUserDN
End If
On Error GoTo 0
Else
objUser.mailNickname = strmailNickname
On Error Resume Next
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to set mailNickname for user " _
& strUserDN
End If
On Error GoTo 0
End If

If strfacsimileTelephoneNumber = "" Then
On Error GoTo 0
Wscript.Echo "Skipped - field was blank"
End If
If LCase(strfacsimileTelephoneNumber) = ".delete" Then
On Error Resume Next
objUser.PutEx ADS_PROPERTY_CLEAR, "facsimiletelephoneNumber", 0
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to clear fax for user " _
& strUserDN
End If
On Error GoTo 0
Else
objUser.facsimileTelephoneNumber = strfacsimileTelephoneNumber
On Error Resume Next
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to set fax for user " _
& strUserDN
End If
On Error GoTo 0
End If

If strgivenName = "" Then
On Error GoTo 0
Wscript.Echo "Skipped - field was blank"
End If
If LCase(strgivenName) = ".delete" Then
On Error Resume Next
objUser.PutEx ADS_PROPERTY_CLEAR, "givenName", 0
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to clear givenName for user " _
& strUserDN
End If
On Error GoTo 0
Else
objUser.givenName = strgivenName
On Error Resume Next
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to set givenName for user " _
& strUserDN
End If
On Error GoTo 0
End If

If strinitials = "" Then
On Error GoTo 0
Wscript.Echo "Skipped - field was blank"
End If
If LCase(strinitials) = ".delete" Then
On Error Resume Next
objUser.PutEx ADS_PROPERTY_CLEAR, "initials", 0
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to clear initials for user " _
& strUserDN
End If
On Error GoTo 0
Else
objUser.initials = strinitials
On Error Resume Next
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to set initials for user " _
& strUserDN
End If
On Error GoTo 0
End If

If strsn = "" Then
On Error GoTo 0
Wscript.Echo "Skipped - field was blank"
End If
If LCase(strsn) = ".delete" Then
On Error Resume Next
objUser.PutEx ADS_PROPERTY_CLEAR, "sn", 0
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to clear sn for user " _
& strUserDN
End If
On Error GoTo 0
Else
objUser.sn = strsn
On Error Resume Next
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to set sn for user " _
& strUserDN
End If
On Error GoTo 0
End If

If strtelephoneNumber = "" Then
On Error GoTo 0
Wscript.Echo "Skipped - field was blank"
End If
If LCase(strtelephoneNumber) = ".delete" Then
On Error Resume Next
objUser.PutEx ADS_PROPERTY_CLEAR, "telephoneNumber", 0
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to clear profilePath for user " _
& strUserDN
End If
On Error GoTo 0
Else
objUser.telephoneNumber = strtelephoneNumber
On Error Resume Next
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to set telephoneNumber for user " _
& strUserDN
End If
On Error GoTo 0
End If

If strtitle = "" Then
On Error GoTo 0
Wscript.Echo "Skipped - field was blank"
End If
If LCase(strtitle) = ".delete" Then
On Error Resume Next
objUser.PutEx ADS_PROPERTY_CLEAR, "title", 0
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to clear title for user " _
& strUserDN
End If
On Error GoTo 0
Else
objUser.title = strtitle
On Error Resume Next
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to set title for user " _
& strUserDN
End If
On Error GoTo 0
End If

If strphysicalDeliveryOfficeName = "" Then
On Error GoTo 0
Wscript.Echo "Skipped - field was blank"
End If
If LCase(strphysicalDeliveryOfficeName) = ".delete" Then
On Error Resume Next
objUser.PutEx ADS_PROPERTY_CLEAR, "physicalDeliveryOfficeName",
0
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to clear physicalDeliveryOfficeName for
user " _
& strUserDN
End If
On Error GoTo 0
Else
objUser.physicalDeliveryOfficeName =
strphysicalDeliveryOfficeName
On Error Resume Next
objUser.SetInfo
If Err.Number <> 0 Then
On Error GoTo 0
Wscript.Echo "Unable to set physicalDeliveryOfficeName for
user " _
& strUserDN
End If
On Error GoTo 0
End If
intRow = intRow + 1
Loop

' Close the workbook.
objExcel.ActiveWorkbook.Close

' Quit Excel.
objExcel.Application.Quit

' Clean up.
Set objUser = Nothing
Set objExcel = Nothing
Set obj*** = Nothing
Set objRootDSE = Nothing
Set objTrans = Nothing

Wscript.Echo "Done"

.

Quantcast