[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1614
  • Last Modified:

VBScript Error -2147467259 PLEASE HELP!

I was asked to make a simple script to change office locations for a group of users, using an excel document as a source. So I whipped something up in a few minutes to do just that, although its turning out to be more of a hassle than I thought it would be. As you can see from the ouput at the bottom Im getting error -2147467259. Oddly enough one of them actually works. From that error I cant tell if its my code or if its something else.

Any help would be VERY much appreciated.


Set objExcel = CreateObject("Excel.Application")
    objExcel.Workbooks.Open("a2move.xls")
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
intRow = 2
Do Until Trim(objSheet.Cells(intRow,1).Value) = ""
      Name = objSheet.Cells(intRow, 3).Value & " " & objSheet.Cells(intRow, 2).Value
      Err.Clear
      Set objUser = GetObject("LDAP://CN=" & Name & ",CN=Users,DC=ACTV2,DC=com")
      If Err Then
            Err.Clear
            Set objUser = GetObject("LDAP://CN=" & Name & ",OU=Contractors,OU=Employees,DC=mycompany,DC=com")
            If Err Then
                  Err.Clear
                  Set objUser = GetObject("LDAP://CN=" & Name & ",OU=ProActivators,OU=IT Administration,OU=Employees,DC=mycompany,DC=com")
                  If Err Then
                        Err.Clear
                        Set objUser = GetObject("LDAP://CN=" & Name & ",OU=Quality Assurance,OU=IT Administration,OU=Employees,DC=mycompany,DC=com")
                        If Err Then
                              Err.Clear
                              Set objUser = GetObject("LDAP://CN=" & Name & ",OU=Marketing,OU=DAC,OU=Employees,DC=mycompany,DC=com")
                        End If      
                  End If      
            End If      
      End If      
      WScript.StdOut.Write "Writing to: " & Name
      If Len(Name) < 12 Then
            WScript.StdOut.Write vbTab & vbTab
      ElseIf Len(Name) > 19 then
            Wscript.StdOut.Write ""
      Else
            WScript.StdOut.Write vbTab
      End If
      
      If Err Then
            Wscript.StdOut.write vbTab & objSheet.Cells(intRow, 5).Value & " >> " & objSheet.Cells(intRow, 6).Value
            WScript.StdOut.Write vbTab & "Error - User Disabled or Not Found"
            ErrCount = ErrCount + 1
      Else
            Err.Clear
            WriteAttribute objUser,"physicalDeliveryOfficeName",objSheet.Cells(intRow, 6).Value
            Wscript.StdOut.write vbTab & objSheet.Cells(intRow, 5).Value & " >> " & objSheet.Cells(intRow, 6).Value
            If Err Then
                  WScript.StdOut.Write vbTab & Err.Number
            Else
                  WScript.StdOut.Write vbTab & "Done"      
            End If      
      End If
      WScript.StdOut.Writeline
          intRow = intRow + 1
Loop

WScript.StdOut.Writeline
WScript.StdOut.Writeline "Errors: " & ErrCount

objExcel.ActiveWorkbook.Close
objExcel.Application.Quit

Sub WriteAttribute(objUser,strAttribute,strValue)
            objUser.Put strAttribute, strValue
            objUser.SetInfo
End Sub

Im sure I could have found a better way than that dirty nested if structure but I had to do it quickly and that was the easiest way. As I couldnt figure out how to get substring filters working with the GetObject function using those LDAP queries.

Output:
Writing to: Suzanne Baietto             5234M >> 1918   -2147467259
Writing to: Ramesh Bhogavally           5237N >> 1911   -2147467259
Writing to: Angela Bilyeu               5034M >> 2017   -2147467259
Writing to: Tai Brissette               5037N >> 1917   -2147467259
Writing to: John Buchanan               5239N >> 1811   -2147467259
Writing to: Van Dishmon                 5236M >> 2015   -2147467259
Writing to: David Herring               5141N >> 1717   -2147467259
Writing to: Martin Horwitz              5136M >> 2014   -2147467259
Writing to: Genevieve Imhoff            5241N >> 1718   -2147467259
Writing to: James Johnson               5039N >> 1816   -2147467259
Writing to: Paresh Joshi                5133M >> 1617   -2147467259
Writing to: Betty Joyner                5138N >> 1815   -2147467259
Writing to: David Kirk                  5232M >> 1618   -2147467259
Writing to: Hal Korff                   7227D >> 1711   -2147467259
Writing to: Cory Lamle                  3602M >> 1615   -2147467259
Writing to: Louis Mastropietro          5040N >> 1715   -2147467259
Writing to: Yana Morford                5041N >> 1817   -2147467259
Writing to: Kanchan Nainani             5134M >> 2018   -2147467259
Writing to: Jim Nedved                  7227H >> 1813/1913      Done
Writing to: Jim Peterson                5139N >> 1714   -2147467259
Writing to: Barry Plumb                 7227C >> 1514   -2147467259
Writing to: Robert Riley                5132M >> 1516   -2147467259
Writing to: Shimon Rothschild           5032M >> 1616   -2147467259
Writing to: Hamboli Savannah            7227A >> 2012   -2147467259
Writing to: Duane Schmoyer              7227F >> 1517   -2147467259
Writing to: Mark Sherwood               7227B >> 2013   -2147467259
Writing to: Geoff Shohan                5233M >> 1518   -2147467259
Writing to: Lauren Snyder               5137N >> 2011   -2147467259
Writing to: Farhan Syed                 5140N >> 1716   -2147467259
Writing to: Carla West                  5240N >> 1818   -2147467259
Writing to: Deepa Yarlagadda            5036M >> 1910   -2147467259
0
Halonix666
Asked:
Halonix666
  • 3
  • 2
1 Solution
 
[ fanpages ]IT Services ConsultantCommented:
Do you know on which line is the Error (to set Err.Number = -2147467259) raised?

BFN,

fp.
0
 
Chris DentPowerShell DeveloperCommented:

You're trying to go through an AD structure to find a specific user then add a physicalDeliveryOfficeName value?

You might consider changing over to something like this:


On Error Resume Next

Const ADS_SCOPE_SUBTREE = 2

Set objUsers = CreateObject("Scripting.Dictionary")

Set objExcel = CreateObject("Excel.Application")
    objExcel.Workbooks.Open("a2move.xls")
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
intRow = 2
Do Until Trim(objSheet.Cells(intRow,1).Value) = ""
     strOffice = objSheet.Cells(intRow, 6).Value
     If Not objUsers.Exists(objSheet.Cells(intRow, 3).Value & " " & objSheet.Cells(intRow, 2).Value) Then
          objUsers.Add objSheet.Cells(intRow, 3).Value & " " & objSheet.Cells(intRow, 2).Value, strOffice
     End If
Loop

Set objConnection = CreateObject("ADODB.Connection")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection

Set objRootDSE = GetObject("LDAP://RootDSE")
objCommand.CommandText = "SELECT aDSPath, name FROM 'LDAP://" &_
          objRootDSE.Get("defaultNamingContext") & "' WHERE objectClass='user'"
Set objRootDSE = Nothing

objCommand.Properties("Page Size") = 1000
objCommand.Properties("Timeout") = 600
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
objCommand.Properties("Cache Results") = False

Set objRecordSet = objCommand.Execute
While Not objRecordSet.EOF
     If objUsers.Exists(objRecordSet.Fields("name")) Then
          Set objUser = GetObject(objRecordSet.Fields("aDSPath"))

          objUser.Put "physicalDeliveryOfficeName", objUsers(objRecordSet.Fields("name"))
          objUser.SetInfo
     End If
     objRecordSet.MoveNext
Wend

objConnection.Close

Set objRecordSet = Nothing
Set objCommand = Nothing
Set objConnection = Nothing
0
 
Chris DentPowerShell DeveloperCommented:

If you want to find out which users you haven't set after all that you just alter a few lines:

objUser.Put "physicalDeliveryOfficeName", objUsers(objRecordSet.Fields("name"))
objUser.SetInfo
objUsers.Remove(objRecordSet.Fields("name"))

Then at the end of it all you can loop through what's left in the dictionary object (objUsers).

I also missed this out of the script above:

intRow = intRow + 1

Which is obviously important or you never get to the end of that loop.

If you need to know which lines failed as well then a few more changes are required. First lets add it into the dictionary object when we first create it:

objUsers.Add objSheet.Cells(intRow, 3).Value & " " & objSheet.Cells(intRow, 2).Value, Array(strOffice, intRow)

Now when we come to checking against that we have to change how we address the value for the key (the name is the key):

objUser.Put "physicalDeliveryOfficeName", objUsers(objRecordSet.Fields("name"))(0)

Which picks the first element of the array we have stored.

Outputting what's left would also need to account for that:

For Each strUser in objUsers
     WScript.Echo "Couldn't Find: " & strUser & " from Row: " & objUsers(strUser)(1) & " to set Office: " &_
          objUsers(strUser)(0)
Next


Chris
0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 
Halonix666Author Commented:
I was already in the process of re-writing the whole thing simlilar to what you posted. But you just made the job alot easier :) Thanks!
0
 
Halonix666Author Commented:
Actually one thing I noticed... the last nested if statement in my script references a different dc. Which might be part of the problem I was having in the first place. Either way some of the accounts are on different domains, your script should still work but I will have to modify it to work on the other domain as well. Anyhow, thanks again!
0
 
Chris DentPowerShell DeveloperCommented:

It defaults to the current domain with the use of objRootDSE.Get("defaultNamingContext"). If you want to search multiple domains then I would recomend making the entire ADODB query a Subroutine. That's how I handle it in my scripts that require access to multiple domains.

I haven't added error handling, I kind of assumed you were already quite familiar with it from your first script.

Otherwise:


On Error Resume Next

' Global Variables

Dim objUsers, objExcel, objSheet, objRootDSE
Dim strOffice
Dim intRow

'
' Subroutines
'

Sub FindUsers(strDomainDN)

      Dim objConnection, objCommand, objRecordSet, objUser

      Const ADS_SCOPE_SUBTREE = 2

      Set objConnection = CreateObject("ADODB.Connection")
      objConnection.Provider = "ADsDSOObject"
      objConnection.Open "Active Directory Provider"

      Set objCommand = CreateObject("ADODB.Command")
      objCommand.ActiveConnection = objConnection

      objCommand.CommandText = "SELECT aDSPath, name FROM 'LDAP://" &_
            strDomainDN & "' WHERE objectClass='user'"

      objCommand.Properties("Page Size") = 1000
      objCommand.Properties("Timeout") = 600
      objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
      objCommand.Properties("Cache Results") = False

      Set objRecordSet = objCommand.Execute
      While Not objRecordSet.EOF
            If objUsers.Exists(objRecordSet.Fields("name")) Then
                  Set objUser = GetObject(objRecordSet.Fields("aDSPath"))
            
                  objUser.Put "physicalDeliveryOfficeName", _
                                    objUsers(objRecordSet.Fields("name"))(0)
                  objUser.SetInfo
                  objUsers.Remove(objRecordSet.Fields("name"))
            End If
            objRecordSet.MoveNext
      Wend

      objConnection.Close

      Set objRecordSet = Nothing
      Set objCommand = Nothing
      Set objConnection = Nothing
End Sub

'
' Main Code
'

Set objUsers = CreateObject("Scripting.Dictionary")

Set objExcel = CreateObject("Excel.Application")
    objExcel.Workbooks.Open("a2move.xls")
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
intRow = 2
Do Until Trim(objSheet.Cells(intRow,1).Value) = ""
      strOffice = objSheet.Cells(intRow, 6).Value
      If Not objUsers.Exists(objSheet.Cells(intRow, 3).Value & " " & objSheet.Cells(intRow, 2).Value) Then
            objUsers.Add objSheet.Cells(intRow, 3).Value & " " &_
                  objSheet.Cells(intRow, 2).Value, Array(strOffice, intRow)
      End If
      intRow = intRow + 1
Loop

Set objRootDSE = GetObject("LDAP://RootDSE")
FindUsers objRootDSE.Get("defaultNamingContext")
Set objRootDSE = Nothing
FindUsers "DC=Domain2,DC=net"
0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now