Hello,
We have recently migrated our Active Roles server from version 6.5 on a Windows 2003 server to version 6.7 on a Windows 2008 R2 server. Since we have migrated our user provisioning scripts have begun failing. The error I get is 429:ActiveX component can't create object. See the script below. I have highlighted the line that produces the error.
Any help is appreciated. Thanks.
Sub onPostCreate(Request)
If Request.Class <> "user" Then Exit Sub
On Error Resume Next
Sleep 5000
'Access Masks
Const FullControl = 2032127
' Const ModifySpecial = 1245695
' Const Modify = 1245631
' Const ReadWrite = 1180095
' Const ReadExecute = 1179817
' Const ListFolders = 1179817
' Const TraverseFolder = 1048608
'ACE Flags
Const All = 3
' Const FolderOnly = 0
' Const FolderSubfolders = 2
' Const FolderFiles = 1
' Const SubfoldersFiles = 11
' Const Subfolders = 10
' Const Files = 9
' Const ADS_RIGHT_GENERIC_READ = &H80000000
' Const ADS_RIGHT_GENERIC_EXECUTE = &H20000000
' Const ADS_RIGHT_GENERIC_ALL = &h10000000
' Const ADS_ACEFLAG_INHERIT_ACE = &h2
Const ADS_ACETYPE_ACCESS_ALLOWED = 0
Dim oFSO,sec,item,oFolder,oUser,sd,dacl,ace1
Dim sDomain,sPath,sUsername,sFolderName,sFolderPath,ace,iCount
'Set up basic scripting objects
Set oFSO = CreateObject("Scripting.FileSystemObject")
'Setup security object
Set sec = CreateObject("ADsSecurity")
sDomain = "ICC_GO"
sUserPath = "\\server1\users$"
sHomePath = "\\server1\home$"
Set oUser = GetObject("EDMS://" & Request.Name)
If err <> 0 Then
echoLog "Error1 " & err & ":" & err.Description
err.Clear
End If
sUsername = oUser.samAccountName
If oFSO.FolderExists(sUserPath) Then
If Not oFSO.FolderExists(sUserPath & "\" & sUsername) Then
oFSO.CreateFolder(sUserPath & "\" & sUsername )
If err <> 0 Then
echoLog "Error2 " & err & ":" & err.Description
err.Clear
End If
Set oFolder = oFSO.GetFolder(sUserPath & "\" & sUsername )
If err <> 0 Then
echoLog "Error3 " & err & ":" & err.Description
err.Clear
End If
sFolderName = oFolder.Name
sFolderPath = oFolder.Path
echoLog "Created Folder: " & sFolderPath
oUser.Put "edsaWTSUserConfigTerminalServerProfilePath",sUserPath & "\" & sUsername
oUser.SetInfo
If err <> 0 Then
echoLog "Error4 " & err & ":" & err.Description
err.Clear
End If
Set sd = sec.GetSecurityDescriptor("FILE://" & sFolderPath)
Set dacl = sd.DiscretionaryAcl
If err <> 0 Then
echoLog "Error5 " & err & ":" & err.Description
err.Clear
End If
Set ace1 = CreateObject("AccessControlEntry")
ace1.Trustee = sDomain & "\" & sUsername
ace1.AccessMask = FullControl
ace1.AceType = ADS_ACETYPE_ACCESS_ALLOWED
ace1.aceFlags = All
dacl.AddAce ace1
sd.DiscretionaryAcl = dacl
sec.SetSecurityDescriptor sd
If err <> 0 Then
If err = -2147023559 Then
iCount = 1
Do While err = -2147023559
If iCount <= 250 Then
err.Clear
iCount = iCount + 1
Sleep 15000
sec.SetSecurityDescriptor sd
Else
echoLog "Error6 Could not find User account to set Folder ACLs"
SendMail Request.Name & " could not be found set profile permissions.","UserAdmin@company.com"
Exit Do
End If
Loop
End If
Else
echoLog "Error6 " & err & ":" & err.Description
err.Clear
End If
Else
echoLog sUserPath & "\" & sUsername & " already exists"
End If
If Not oFSO.FolderExists(sHomePath & "\" & sUsername) Then
oFSO.CreateFolder(sHomePath & "\" & sUsername )
If err <> 0 Then
echoLog "Error7 " & err & ":" & err.Description
err.Clear
End If
Set oFolder = oFSO.GetFolder(sHomePath & "\" & sUsername )
If err <> 0 Then
echoLog "Error8 " & err & ":" & err.Description
err.Clear
End If
sFolderName = oFolder.Name
sFolderPath = oFolder.Path
echoLog "Created Folder: " & sFolderPath
oUser.Put "edsaWTSUserConfigTerminalServerHomeDir",sHomePath & "\" & sUsername
oUser.Put "edsaWTSUserConfigTerminalServerHomeDirDrive","P:"
oUser.SetInfo
If err <> 0 Then
echoLog "Error9 " & err & ":" & err.Description
err.Clear
End If
Set sd = sec.GetSecurityDescriptor("FILE://" & sFolderPath)
Set dacl = sd.DiscretionaryAcl
If err <> 0 Then
echoLog "Error10 " & err & ":" & err.Description
err.Clear
End If
Set ace1 = CreateObject("AccessControlEntry")
ace1.Trustee = sDomain & "\" & sUsername
ace1.AccessMask = FullControl
ace1.AceType = ADS_ACETYPE_ACCESS_ALLOWED
ace1.aceFlags = All
dacl.AddAce ace1
Set ace2 = CreateObject("AccessControlEntry")
ace2.Trustee = "ICC_GO\OneWorld Admins"
ace2.AccessMask = FullControl
ace2.AceType = ADS_ACETYPE_ACCESS_ALLOWED
ace2.aceFlags = All
dacl.AddAce ace2
Set ace3 = CreateObject("AccessControlEntry")
ace3.Trustee = "ICC_GO\ProfileAdmin.Admins.SG"
ace3.AccessMask = FullControl
ace3.AceType = ADS_ACETYPE_ACCESS_ALLOWED
ace3.aceFlags = All
dacl.AddAce ace3
sd.DiscretionaryAcl = dacl
sec.SetSecurityDescriptor sd
If err <> 0 Then
If err = -2147023559 Then
iCount = 1
Do While err = -2147023559
If iCount <= 250 Then
err.Clear
iCount = iCount + 1
Sleep 15000
sec.SetSecurityDescriptor sd
Else
echoLog "Error11 Could not find User account to set Folder ACLs"
SendMail Request.Name & " could not be found set profile permissions.","UserAdmin@company.com"
Exit Do
End If
Loop
End If
Else
echoLog "Error11 " & err & ":" & err.Description
err.Clear
End If
Else
echoLog sHomePath & "\" & sUsername & " already exists"
End If
Else
echoLog sPath & " not found"
End If
End Sub
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Sub echoLog(sMessage)
Dim oLogFSO, fLog
Set oLogFSO = CreateObject("Scripting.FileSystemObject")
Set fLog = oLogFSO.OpenTextFile("c:\TIN.ICC_GO.TSPROF-Folder-Create.log", 8, True)
fLog.WriteLine(Date & " " & time & " " & sMessage)
fLog.Close
End Sub
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
Sub SendMail(ByVal strMsg, ByVal strMail)
Const strSmtpServer = "smtp.company.com"
Const intSmtpPort = 25
Const strAdminMail ="Quest.ARS@company.com"
Const CdoSendUsingPort =2
Set iMsg = CreateObject("CDO.Message")
With iMsg
.From = strAdminMail
.To = strMail
'.CC = strAdminMail
.Subject = "AUTOMATED ALERT!!! ICC_GO Profile Setup Script"
End With
Set iBp = iMsg.BodyPart
iBp.ContentMediaType = "multipart/mixed"
Set iBp2 = iBp.AddBodyPart
With iBp2
.ContentMediaType = "text/plain"
.ContentTransferEncoding = "7bit"
Set Stm = .GetDecodedContentStream
Stm.WriteText strMsg
Stm.Flush
End With
' Configure message
Set iConf = CreateObject("CDO.Configuration")
Set Flds = iConf.Fields
Flds("http://schemas.microsoft.com/cdo/configuration/sendusing") = CdoSendUsingPort
Flds("http://schemas.microsoft.com/cdo/configuration/smtpserver") = strSmtpServer
Flds("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = intSmtpPort
Flds.Update
Set iMsg.Configuration = iConf
' Send message
iMsg.Send
End Sub