saving new user settings problem

Forums

My Profile

Inbox

Address Book

My Subscription

My Forums

saving new user settings problem

Logged in as: Guest

arrSession:exec spGetSession 2,2,33994

	Active Users: There are 0 members and 0 guests.
	Users viewing this topic: none

Printable Version

All Forums >> [Scripting] >> WSH & Client Side VBScript >> saving new user settings problem
Do you like VisualBasicScript.com? Link to us and help spread the word about our forum. Thanks!

Page: [1]

Message

<< Older Topic Newer Topic >>

saving new user settings problem - 4/26/2006 7:16:45 PM

Bezerk

Posts: 22
Score: 0
Joined: 6/20/2005
From: Netherlands
Status: offline

Because management wants all user attibutes updated, i have created a script that read the export excel sheet of our helpdesk software.
I search in AD for a duplicate email adress (because that's the only thing i have got)

Then when i update the records and on the bottom try to do objUser.SetInfo , i crashes, it seems like it no longer has connection to AD.

If i do a objUser.SetInfo after every entry that i update it works fine.

'all variables must be declared
option explicit
'on error continue
'on error resume next 'comment out for debugging
'declare variables
'declare objects
Dim objConnection
Dim objCommand
Dim objRecordSet
Dim objUser
Dim objOUBase
Dim objRootDSE
Dim objExcel
Dim objExcelFile
Dim objSheet
'declare strings
Dim strMail
Dim strOUBase
Dim strOU
Dim strDNSDomain
Dim strLogFile
Dim strTelePhoneNumber
Dim strDescription
Dim strphysicalDeliveryOfficeName
Dim strMobile
Dim strIpPhone
Dim strIpPhoneTemp
Dim strCompany
Dim strDepartment
Dim strInfo
Dim strDisplayName
Dim strUser
'declare constants
Dim ADSIPROV
'declare integers
Dim intRow
'fill in general strings and constants, you will have to fill these in to meet your own needs
ADSIPROV = "LDAP://"
strOU = "ou=users,ou=disabled," 'leave out the domain dc's, dont forget the "," at the end
strLogFile = Date() & "-updateusers-AD.log" 'defines the log file
objExcelFile = "E:\Robs Scripts\update_telefoon.xls"
intRow = 2 'we start at row 2, because the first line is for description of the fields
strCompany = "<name>"
'start the logfile
InitLog(strLogFile)
'SET MESSAGE THAT LOGGING HAS STARTED
Log "Update telefoongegevens AD word gestart!",strLogFile
'Determine the DNS domain from the RootDSE object.
Set objRootDSE = GetObject("[link=http://www.visualbasicscript.com/ldap://RootDSE]LDAP://RootDSE[/link]")
strDNSDomain = objRootDSE.Get("defaultNamingContext")
'lets create the OUBase
strOUBase = ADSIPROV & strOU & strDNSDomain
'do a check if we can connect to the base ou we define in strOUBase
Set objOUBase = GetObject (strOUBase)
If Err.Number <> 0 Then
Log "Failed to connect to OUBase: " & strOUBase,strLogFile
'quit the script
Wscript.Quit
End If
'create excel object
Set objExcel = CreateObject("Excel.Application")
'try to open the excel sheet and see if we can open it
objExcel.Workbooks.Open objExcelFile
If Err.Number <> 0 Then
Err.Clear
Log "Can't find the excel sheet: " & objExcelFile,strLogFile
Wscript.Echo "Can't find the excel sheet: " & objExcelFile,strLogFile
'quit the script
Wscript.Quit
End If
'open the first sheet so we can read it
Set objSheet = objExcel.ActiveWorkbook.Worksheets(1)
If Err.Number <> 0 Then
Err.Clear
Log "Can't open the Excelsheet: " & Err.Description,strLogFile
'quit the script
Wscript.Quit
End If
'start the Do While statement
'this loops through the excelsheet reads the data en increment to the next row until the row is empty
Do
'assign values we read from the excelsheet to the strings
strMail = Trim(objSheet.Cells(intRow, 11).Value) 'strMail is the value we are going to use to search AD
strTelePhoneNumber = Trim(objSheet.Cells(intRow, 13).Value)
strDescription = Trim(objSheet.Cells(intRow, 7).Value)
strphysicalDeliveryOfficeName = Trim(objSheet.Cells(intRow, 17).Value)
strMobile = Trim(objSheet.Cells(intRow, 14).Value)
strIpPhoneTemp = Trim(objSheet.Cells(intRow, 13).Value)
'strDepartment moet leeg
strInfo = Trim(objSheet.Cells(intRow, 13).Value)
'Create ADO to connect to AD
Set objConnection = CreateObject("ADODB.Connection")
objConnection.Open "Provider=ADsDSOObject;"
Set objCommand = CreateObject("ADODB.Command")
objCommand.ActiveConnection = objConnection
'create AD query
objCommand.CommandText = _
   "<" & strOUBase & ">;" & _
       "(&(objectCategory=person)(mail=" & strMail & "));" & _
           "distinguishedName,mail;subtree"
'execute the query
Set objRecordSet = objCommand.Execute
'check if we find the mail adress
If objRecordset.EOF Then
   Log "No users found with this mail address.",strLogFile
   
Else
    While Not objRecordset.EOF
     strUser = ADSIPROV & objRecordset.Fields("distinguishedName")
    objRecordset.MoveNext
   Wend
End If
'close connection to AD
objConnection.Close
'update user records
Set objUser = GetObject(strUser)
If Err.Number <> 0 Then
Err.Clear
Log "Can't connect to user AD properties!",strLogFile
End If
   
'grab the users displayname, just for logging purpose
strDisplayName = objUser.DisplayName
 If Err.Number <> 0 Then
 Err.Clear
 Log "Can't connect to user displayname",strLogFile
 End If
'ipphone is the last 4 numbers from the right side of telephonenumber
strIpPhone = Right(strIpPhoneTemp, 4)
If Err.Number <> 0 Then
Err.Clear
Log "Kan IpPhone van: " & strDisplayName & "niet berekenen!",strLogFile
End If

If strTelePhoneNumber <> "" Then
 objUser.telephoneNumber = strTelePhoneNumber
 If Err.Number <> 0 Then
 Err.Clear
 Log "Kan telefoonnumber van: " & strDisplayName & "niet updaten!",strLogFile
 End If
End If
If strDescription <> "" Then
 objUser.Description = strDescription
 If Err.Number <> 0 Then
 Err.Clear
 Log "Kan afdeling van: " & strDisplayName & "niet updaten!",strLogFile
 End If
End If
If strphysicalDeliveryOfficeName <> "" Then
 objUser.physicalDeliveryOfficeName = strphysicalDeliveryOfficeName
 If Err.Number <> 0 Then
 Err.Clear
 Log "Kan locatie van: " & strDisplayName & "niet updaten!",strLogFile
 End If
End If
  
If strMobile <> "" Then
 objUser.Mobile = strMobile
 If Err.Number <> 0 Then
 Err.Clear
 Log "Kan mobiel van: " & strDisplayName & "niet updaten!",strLogFile
 End If
End If
If strIpPhone <> "" Then
 objUser.IPphone = strIpPhone
 If Err.Number <> 0 Then
 Err.Clear
 Log "Kan IpPhone van: " & strDisplayName & "niet updaten!",strLogFile
 End If
End If
  
If strCompany <> "" Then
 objUser.Company = strCompany
 If Err.Number <> 0 Then
 Err.Clear
 Log "Kan Company van: " & strDisplayName & "niet updaten!",strLogFile
 End If
End If
If strInfo <> "" Then
 objUser.Info = strInfo
 If Err.Number <> 0 Then
 Err.Clear
 Log "Kan Info van: " & strDisplayName & "niet updaten!",strLogFile
 End If
End If
'we have to set the department to empty
objUser.Department = ""
 If Err.Number <> 0 Then
 Err.Clear
 Log "Kan Department van: " & strDisplayName & "niet updaten!",strLogFile
 End If
  
'set the new userinfo
objUser.SetInfo
If Err.Number <> 0 Then
Err.Clear
Log "Can't write updates to user: " & strDisplayName
End If

'Increment to next user.
intRow = intRow + 1
Loop Until objSheet.Cells(intRow, 1).Value = ""
'close all excel stuff
objExcel.ActiveWorkbook.Close
objExcel.Application.Quit
'set all objects to nothing
Set objConnection = Nothing
Set objCommand = Nothing
Set objRecordSet = Nothing
Set objUser = Nothing
Set objOUBase = Nothing
Set objRootDSE = Nothing
Set objExcelFile = Nothing
Set objExcel = Nothing
Set objSheet = Nothing
'echo that we are done
Wscript.Echo "DONE!"
Log "Script is DONE!",strLogFile
'quit the script
Wscript.Quit
'--------------------------------------------------------------------------------------------------
'FUNCTIONS SECTION
'FUNCTIONS
'Function InitLog(strFile)   - CREATES A LOG FILE AND CAN ALSO CREATE A DIRECTORY
Function InitLog( strFile )    '- Returns TRUE or FALSE
   Dim objNetwork,objFso,LogWrite
   On Error Resume Next
   Set objFso = CreateObject("Scripting.FileSystemObject")
   Set objNetwork = WScript.CreateObject("WScript.Network")
   If Not objFso.FileExists( strFile  ) Then
Set LogWrite = objFSO.CreateTextFile(strFile,True)
    LogWrite.WriteLine("- Log created on " & Date & " " & Time)
LogWrite.Close 
   End If
End Function
'Function Log(strMessage,STR_LOGFILENAME )   - Write to LOG file
Function Log(strMessage,STR_LOGFILENAME)    ' - Returns TRUE or FALSE
   Dim strLine, objFso, objFile, objStream
   On Error Resume Next
   Set objFso = CreateObject("Scripting.FileSystemObject")
   strLine = Date() & " " & Time() & ": " & strMessage
   Set objFile = objFso.GetFile( STR_LOGFILENAME )
   Set objStream = objFile.OpenAsTextStream(8)
   objStream.WriteLine( strLine )
   objStream.Close
   Set objStream = Nothing
   Set objFile   = Nothing
   Set objFso    = Nothing
End Function