Hi Scripting Guy!
Sorry if I'm asking something stupid here but I'm very new to scripting and am uncertain of the 'cans and cannot'!
I have three vbs scripts which I use that, when run in order (but separately), work very well. What I would like however, is that rather than having to call each script in sequence from a fourth script run at logon would be to have one single script (ie the three scripts merged) to be run.
The job of each script is as follows;
1) Extract 'sAMAccountName' and 'url' values from AD
2) Generate random, four digit numbers and assign them to the empty 'url' value
3) Import back to AD
Script 1;
OPTION EXPLICIT
dim FileName, multivaluedsep,strAttributes
dim strFilter, strRoot, strScope
dim cmd, rs,cn
dim objRoot, objFSO,objCSV
dim comma, q, i, j, mvsep, strAttribute, strValue
' ********************* Setup *********************
' The filename of the csv file produced by this script
FileName ="c:\Automated ID Update\output\userexport.csv"
' Seperator used for multi-valued attributes
multivaluedsep = ";"
' comma seperated list of attributes to export
strAttributes = "sAMAccountName,url"
' Default filter for all user accounts (ammend if required)
strFilter = "(&(objectCategory=person)(objectClass=user))"
' scope of search (default is subtree - search all child OUs)
strScope = "subtree"
' search root. e.g. ou=MyUsers,dc=wisesoft,dc=co,dc=uk
' leave blank to search from domain root
strRoot = ""
' *************************************************
q = """"
set cmd = createobject("ADODB.Command")
set cn = createobject("ADODB.Connection")
set rs = createobject("ADODB.Recordset")
cn.open "Provider=ADsDSOObject;"
cmd.activeconnection = cn
if strRoot = "" then
set objRoot = getobject("LDAP://RootDSE")
strRoot = objRoot.get("defaultNamingContext")
end if
cmd.commandtext = "<LDAP://" & strRoot & ">;" & strFilter & ";" & _
strAttributes & ";" & strScope
'**** Bypass 1000 record limitation ****
cmd.properties("page size")=1000
set rs = cmd.execute
set objFSO = createobject("Scripting.FileSystemObject")
set objCSV = objFSO.createtextfile(FileName)
comma = "" ' first column does not require a preceding comma
i = 0
' create a header row and count the number of attributes
for each strAttribute in SPLIT(strAttributes,",")
objcsv.write(comma & q & strAttribute & q)
comma = "," ' all columns apart from the first column require a preceding comma
i = i + 1
next
' for each item returned by the Active Directory query
while rs.eof <> true and rs.bof <> true
comma="" ' first column does not require a preceding comma
objcsv.writeline ' Start a new line
' For each column in the result set
for j = 0 to (i - 1)
select case typename(rs(j).value)
case "Null" ' handle null value
objcsv.write(comma & q & q)
case "Variant()" ' multi-valued attribute
' Multi-valued attributes will be seperated by value specified in
' "multivaluedsep" variable
mvsep = "" 'No seperator required for first value
objcsv.write(comma & q)
for each strValue in rs(j).Value
' Write value
' single double quotes " are replaced by double double quotes ""
objcsv.write(mvsep & replace(strValue,q,q & q))
mvsep = multivaluedsep ' seperator used when more than one value returned
next
objcsv.write(q)
case else
' Write value
' single double quotes " are replaced by double double quotes ""
objcsv.write(comma & q & replace(rs(j).value,q,q & q) & q)
end select
comma = "," ' all columns apart from the first column require a preceding comma
next
rs.movenext
wend
' Close csv file and ADO connection
cn.close
objCSV.Close
Script 2;
' VB Script Document
option explicit
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
'Variables'
DIM Found
DIM MaxValue
DIM MinValue
DIM NumUnique 'The number of unique numbers required
DIM Count
DIM strCSVHeader, strCSVFile, strnewCSVFile, strCSVFolder
DIM cn,cmd,rs,fsObj,objDictionary,objPinDictionary,fsObjnewcsv
DIM newNum,urls,sAMAccountNames,un,pc,temppc
'Initialize variables'
Found=false
MaxValue=9999
MinValue=1111
' NumUnique is used only when creating a new list
NumUnique=8000
Count=0
DIM Current(8000)
DIM objExcel,objWorkbook ' object to hold the excel sheet
'***************************************
'* set up for creating a blank csv of urls to apply to some sAMAccountNames
'***************************************
'If you dont have an existing list then leave the filename blank, this will Create
'a spreadsheet with a list of numbers.
'***************************************
'* set up for existing csv of sAMAccountNames and urls
'***************************************
' use an existing list of sAMAccountNames and pin codes that you want to add
' additional names to. The script will apply new pin codes to the new names
' and check that they are unique in the range specified and in relation To
' the existing numbers issued.
'
' csv file should have the following headers.
'
' sAMAccountName,url
' Folder where CSV file is located
strCSVFolder = "C:\Automated ID Update\output\"
' Name of the existing CSV File
strCSVFile = "userexport.csv"
' Name of the new CSV File
strnewCSVFile = "newusermod.csv"
' *************************************************
' * End Setup
' *************************************************
' check for and Setup ADO Connection to CSV file
set fsObj = CreateObject("Scripting.FileSystemObject")
if (fsObj.FileExists((strCSVFolder & strCSVFile))) Then
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
' this will only work in 32 bit mode. so if on a 64 bit device the script
' must be run from c:\windows\syswow64\cscript
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strCSVFolder & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
rs.Open "SELECT * FROM [" & strCSVFile & "]", _
cn, adOpenStatic, adLockOptimistic, adCmdText
set objDictionary = CreateObject("Scripting.Dictionary")
set objPinDictionary = CreateObject("Scripting.Dictionary")
Do Until rs.EOF
un = rs.Fields.Item("sAMAccountName")
pc = rs.Fields.Item("url")
objDictionary.add un,pc
if isNull(pc) Then
'do nothing
Else
objPinDictionary.add pc,""
End If
rs.MoveNext
Loop
sAMAccountNames = objDictionary.Keys
For Each un In sAMAccountNames
if IsNull(objDictionary.Item(un)) Then
'create new pin
Do While IsNull(objDictionary.Item(un))
newNum = getRandom()
if objPinDictionary.Exists(newNum) Then
' do Nothing
Else
objPinDictionary.Add newNum,""
objDictionary.Item(un) = newNum
End If
Loop
Else
' do Nothing
End If
Next
set fsObjnewcsv = fsObj.CreateTextFile((strCSVFolder & strnewCSVFile))
fsObjnewcsv.writeline "sAMAccountName,url"
For Each un In sAMAccountNames
fsObjnewcsv.writeline un & "," & objDictionary.Item(un)
Next
Else
'fsObj = Nothing
'Setup spreadsheet'
Set objExcel= CreateObject("Excel.Application")
objExcel.Visible = True
objExcel.Workbooks.Add
objExcel.Cells(1, 1).Value = "Unique number"
checkUnique()
End If
'*********** Procedures ****************'
Sub addToWorkbook(rowcount, url)
objExcel.Cells(rowcount,1).value = url
End Sub
Sub checkUnique()
DO While Count<NumUnique
Found = false
DIM rndNumber
rndNumber = getRandom
DIM j
j = 0
DO While j<NumUnique
If (Current(j) = rndNumber) Then
Found = true
Exit Do
End If
j = j + 1
Loop
IF (Found) Then
'Count = Count - 1
Else
Current(Count) = rndNumber
addToWorkbook (Count+2),rndNumber
Count = Count + 1
End If
Loop
End Sub
Function getRandom()
DIM ranNum
Randomize
getRandom = Int((MaxValue-MinValue+1)*Rnd+MinValue)
End Function
Script 3;
OPTION EXPLICIT ' Variables must be declared
' *************************************************
' * Instructions
' *************************************************
' Edit the variables in the "Setup" section as required.
' Run this script from a command prompt in cscript mode.
' e.g. cscript usermod.vbs
' You can also choose to output the results to a text file:
' cscript updateADfromCSV.vbs >> results.txt
' if you are running the script on a 64bit system then
' call the script using the 32bit cscript client.
' example c:\windows\syswow64\cscript updateADfromCSV.vbs >> log.txt
'
' if its a 32bit server
' cscript importUserADfromCSV.vbs >> log.txt
' *************************************************
' * Constants / Decleration
' *************************************************
Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
Const ADS_PROPERTY_CLEAR = 1
DIM strSearchAttribute
DIM strCSVHeader, strCSVFile, strCSVFolder
DIM strAttribute, userPath
DIM userChanges
DIM cn,cmd,rs
DIM objUser
DIM oldVal, newVal
DIM objField
DIM blnSearchAttributeExists
' *************************************************
' * Setup
' *************************************************
' The Active Directory attribute that is to be used to match rows in the CSV file to
' Active Directory user accounts. It is recommended to use unique attributes.
' e.g. sAMAccountName (Pre Windows 2000 Login) or userPrincipalName
' Other attributes can be used but are not guaranteed to be unique. If multiple user
' accounts are found, an error is returned and no update is performed.
strSearchAttribute = "sAMAccountName" 'User Name (Pre Windows 2000)
' Folder where CSV file is located
strCSVFolder = "C:\Automated ID Update\output\"
' Name of the CSV File
strCSVFile = "newusermod.csv"
' *************************************************
' * End Setup
' *************************************************
'If Wscript.Arguments.Count = 0 Then
' Wscript.Echo "No file name was specified."
' Wscript.Echo "Syntax: cscript getsysteminfo.vbs servername"
' Wscript.Echo "using default hostname."
' strComputer = "."
' wscript.quit
'Else
' Set objFSO = CreateObject("Scripting.FileSystemObject")
' Set objFile = objFSO.GetFile(Wscript.Arguments(0))
'
' ' Folder where CSV file is located
' strCSVFolder = objFSO.GetParentFolderName(objFile)
' Name of the CSV File
' strCSVFile = objFSO.GetFileName(objFile)
'
'End If
' Setup ADO Connection to CSV file
Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & strCSVFolder & ";" & _
"Extended Properties=""text;HDR=YES;FMT=Delimited"""
rs.Open "SELECT * FROM [" & strCSVFile & "]", _
cn, adOpenStatic, adLockOptimistic, adCmdText
' Check if search attribute exists
blnSearchAttributeExists=false
for each objField in rs.Fields
if UCASE(objField.Name) = UCASE(strSearchAttribute) then
blnSearchAttributeExists=true
end if
Next
if blnSearchAttributeExists=false then
MsgBox "'" & strSearchAttribute & "' attribute must be specified in the CSV header." & _
VbCrLf & "The attribute is used to map the data the csv file to users in Active Directory.",vbCritical
wscript.quit
end if
' Read CSV File
Do Until rs.EOF
' Get the ADsPath of the user by searching for a user in Active Directory on the search attribute
' specified, where the value is equal to the value in the csv file.
' e.g. LDAP://cn=user1,cn=users,dc=wisesoft,dc=co,dc=uk
userPath = getUser(strSearchAttribute,rs(strSearchAttribute))
' Check that an ADsPath was returned
if LEFT(userPath,6) = "Error:" then
wscript.echo userPath
else
wscript.echo userPath
' Get the user object
set objUser = getobject(userpath)
userChanges = 0
' Update each attribute in the CSV string
for each objField in rs.Fields
strAttribute = objField.Name
oldval = ""
newval = ""
' Ignore the search attribute (this is used only to search for the user account)
if UCASE(strAttribute) <> UCASE(strSearchAttribute) and UCASE(strAttribute) <> "NULL" then
newVal = rs(strAttribute) ' Get new attribute value from CSV file
if ISNULL(newval) then
newval = ""
end If
' Special handling for common-name attribute. If the new value contains
' commas they must be escaped with a forward slash.
If strAttribute = "cn" then
newVal = REPLACE(newVal,",","\,")
end If
' Read the current value before changing it
readAttribute strAttribute
' Check if the new value is different from the update value
if oldval <> newval then
wscript.echo "Change " & strAttribute & " from '" & oldVal & "' to '" & newVal & "'"
' Update attribute
writeAttribute strAttribute,newVal
' Used later to check if any changes need to be committed to AD
userChanges = userChanges + 1
end If
end If
next
' Check if we need to commit any updates to AD
if userChanges > 0 then
' Allow script to continue if an update fails
on error resume next
err.clear
' Save Changes to AD
objUser.setinfo
' Check if update succeeded/failed
if err.number <> 0 then
wscript.echo "Commit Changes: Failed. " & err.description
err.clear
else
wscript.echo "Commit Changes: Succeeded"
end if
on error goto 0
else
wscript.echo "No Changes"
end if
end If
userPath = ""
rs.MoveNext
Loop
' Cleanup
rs.close
cn.close
' *************************************************
' * End of script
' *************************************************
' *************************************************
' * Functions
' *************************************************
' Reads specified attribute and sets the value for the oldVal variable
Sub readAttribute(ByVal strAttribute)
Select Case LCASE(strAttribute)
Case "manager_samaccountname"
' special handling to allow update of manager attribute using sAMAccountName (UserName)
' instead of using the distinguished name
Dim objManager, managerDN
' Ignore error if manager is null
On Error Resume Next
managerDN = objUser.Get("manager")
On Error GoTo 0
If managerDN = "" Then
oldVal=""
Else
Set objManager = GetObject("LDAP://" & managerDN)
oldVal = objManager.sAMAccountName
Set objManager=Nothing
End If
Case "terminalservicesprofilepath"
'Special handling for "TerminalServicesProfilePath" attribute
oldVal=objUser.TerminalServicesProfilePath
Case "terminalserviceshomedirectory"
'Special handling for "TerminalServicesHomeDirectory" attribute
oldVal = objUser.TerminalServicesHomeDirectory
Case "terminalserviceshomedrive"
'Special handling for "TerminalServicesHomeDrive" attribute
oldVal=objUser.TerminalServicesHomeDrive
Case "allowlogon"
' Special handling for "allowlogon" (Terminal Services) attribute
' e.g. 1=Allow, 0=Deny
oldVal=objUser.AllowLogon
Case "password"
' Password can't be read, just return ****
oldVal="****"
Case Else
on error resume next ' Ignore error if value is null
' Get old attribute value
oldVal = objUser.Get(strAttribute)
On Error goto 0
End Select
End Sub
' updates the specified attribute
Sub writeAttribute(ByVal strAttribute,newVal)
Select Case LCASE(strAttribute)
Case "cn" 'Special handling required for common-name attribute
DIM objContainer
set objContainer = GetObject(objUser.Parent)
on error resume Next
objContainer.MoveHere objUser.ADsPath,"cn=" & newVal
' The update might fail if a user with the same common-name exists within
' the same container (OU)
if err.number <> 0 Then
wscript.echo "Error changing common-name from '" & oldval & "' to '" & newval & _
"'. Check that the common-name is unique within the container (OU)"
err.clear
End If
on Error goto 0
Case "terminalservicesprofilepath"
'Special handling for "TerminalServicesProfilePath" attribute
objUser.TerminalServicesProfilePath=newVal
Case "terminalserviceshomedirectory"
'Special handling for "TerminalServicesHomeDirectory" attribute
objUser.TerminalServicesHomeDirectory=newVal
Case "terminalserviceshomedrive"
'Special handling for "TerminalServicesHomeDrive" attribute
objUser.TerminalServicesHomeDrive=newVal
Case "allowlogon"
' Special handling for "allowlogon" (Terminal Services) attribute
' e.g. 1=Allow, 0=Deny
objUser.AllowLogon=newVal
Case "password"
' Special handling for setting password
objUser.SetPassword newVal
Case "manager_samaccountname"
' special handling to allow update of manager attribute using sAMAccountName (UserName)
' instead of using the distinguished name
If newVal = "" Then
objUser.PutEx ADS_PROPERTY_CLEAR, strAttribute, Null
Else
Dim objManager, managerPath, managerDN
managerPath = GetUser("sAMAccountName",newVal)
If LEFT(managerPath,6) = "Error:" THEN
wscript.echo "Error resolving manager DN:" & managerPath
Else
SET objManager = GetObject(managerPath)
managerDN = objManager.Get("distinguishedName")
Set objManager = Nothing
objUser.Put "manager",managerDN
End If
End If
Case ELSE ' Any other attribute
' code to update "normal" attribute
If newVal = "" then
' Special handling to clear an attribute
objUser.PutEx ADS_PROPERTY_CLEAR, strAttribute, Null
Else
objUser.put strAttribute,newVal
End If
End Select
End Sub
' Function to return the ADsPath of a user account by searching
' for a particular attribute value
' e.g. LDAP://cn=user1,cn=users,dc=wisesoft,dc=co,dc=uk
Function getUser(Byval strSearchAttribute,strSearchValue)
DIM objRoot
DIM getUserCn,getUserCmd,getUserRS
on error resume next
set objRoot = getobject("LDAP://RootDSE")
set getUserCn = createobject("ADODB.Connection")
set getUserCmd = createobject("ADODB.Command")
set getUserRS = createobject("ADODB.Recordset")
getUserCn.open "Provider=ADsDSOObject;"
getUserCmd.activeconnection=getUserCn
getUserCmd.commandtext="<LDAP://" & objRoot.get("defaultNamingContext") & ">;" & _
"(&(objectCategory=person)(objectClass=user)(" & strSearchAttribute & "=" & strSearchValue & "));" & _
"adsPath;subtree"
set getUserRs = getUserCmd.execute
if getUserRS.recordcount = 0 then
getUser = "Error: User account not found"
elseif getUserRS.recordcount = 1 then
getUser = getUserRs(0)
else
getUser = "Error: Multiple user accounts found. Expected one user account."
end if
getUserCn.close
end function
Thanks in advance!