NT4 Automation Erro with IADsUser 1

[cruford]

I am trying to create NT users and exchange 5.5 mailboxes with a small app. The code below is to create a NT account. The line in red is causing this error:

"Run-Time error '-2147022651 (800708c5)"
"Automation Error"

Anyone know why? If I remove the line the rest of the code works but it doesn't set a password then.

Public Function Create_NT_Account(strDomain As String, _
strAdmin As String, _
strPassword As String, _
UserName As String, _
FullName As String, _
NTServer As String _
) As Boolean

Dim oNS As IADsOpenDSObject
Dim User As IADsUser
Dim Domain As IADsDomain

On Error GoTo Create_NT_Account_Error
Create_NT_Account = False

If (strPassword = "&quot Then
strPassword = ""
End If

Set oNS = GetObject("WinNT:&quot
Set Domain = oNS.OpenDSObject("WinNT://" & strDomain, strDomain & "\" & strAdmin, strPassword, 0)

Set User = Domain.Create("User", UserName)
With User
.Description = "User created by ADSI"
.FullName = FullName
.HomeDirectory = "\\" & NTServer & "\" & UserName
.LoginScript = LOGON_CMD
.SetInfo
' First password = username
.SetPassword UserName
End With

Debug.Print "Successfully created NT Account for user " & UserName
Create_NT_Account = True
Exit Function

Create_NT_Account_Error:

Debug.Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred creating NT account for user " & UserName

End Function

 

[paulbent]

I would try saving the user after setting the password.

With User
    .Description = "User created by ADSI"
    .FullName = FullName
    .HomeDirectory = "\\" & NTServer & "\" & UserName
    .LoginScript = LOGON_CMD
    .SetPassword UserName
    .SetInfo
End With

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[cruford]

Awesome paulbent that worked great, thank you.

One more line giving me the same error and I'm not sure why (it's the line in red)

Public Function Create_Exchange_MailBox( _
IsRemote As Boolean, _
strServer As String, _
strDomain As String, _
strAdmin As String, _
strPassword As String, _
UserName As String, _
EMailAddress As String, _
strFirstName As String, _
strLastName As String, _
ExchangeServer As String, _
ExchangeSite As String, _
ExchangeOrganization As String _
) As Boolean

Dim Container As IADsContainer
Dim strRecipContainer As String
Dim Mailbox As IADs
Dim rbSID(1024) As Byte
Dim OtherMailBox() As Variant
Dim sSelfSD() As Byte
Dim encodedSD() As Byte
Dim I As Integer

Dim oNS As IADsOpenDSObject

'On Error GoTo Create_Exchange_MailBox_Error

Create_Exchange_MailBox = False

If (strPassword = "&quot Then
strPassword = ""
End If

' Recipients container for this server
strRecipContainer = "LDAP://" & ExchangeServer & _
"/CN=Recipients,OU=" & ExchangeSite & _
",O=" & ExchangeOrganization
Set oNS = GetObject("LDAP:&quot
Set Container = oNS.OpenDSObject(strRecipContainer, "cn=" & strAdmin & ",dc=" & strDomain, strPassword, 0)

 

[paulbent]

Is your code taken from Mailbox.bas in the ADSI SDK? If so, this kb article may help:

http://support.microsoft.com/support/kb/articles/q241/8/37.asp

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[cruford]

Yes that is exactly what I am using paulbent.

Ok I checked out the site and took that code and modified it to fit my needs. I am still getting an automation error on:

Set Container = oNS.OpenDSObject(strRecipContainer, "cn=" & strAdmin & ",dc=" & strDomain, strPassword, 0)

I stepped into the code and the values are all correct so I am not sure why its erroring

 

[paulbent]

Hmmm... couldn't say off hand. I can't make any promises (busy at the moment) but if you post your latest code including the bit that first creates the NT user, I'll try to replicate the problem if I get time during the next day or so.

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk

 

[cruford]

Here is what I have for creating the NT/exchange account:

Public Function Create_NT_Account(strDomain As String, _
strAdmin As String, _
strPassword As String, _
UserName As String, _
FullName As String, _
NTServer As String _
) As Boolean

Dim oNS As IADsOpenDSObject
Dim User As IADsUser
Dim Domain As IADsDomain
Dim bolCreateHomeDir As Boolean

On Error GoTo Create_NT_Account_Error

Create_NT_Account = False

If (strPassword = "&quot Then
strPassword = ""
End If

Set oNS = GetObject("WinNT:&quot
Set Domain = oNS.OpenDSObject("WinNT://" & strDomain, strDomain & "\" & strAdmin, strPassword, 0)

Set User = Domain.Create("User", UserName)
With User
.Description = "User created by ADSI"
.FullName = FullName
.LoginScript = "login.bat"
.SetPassword "password01"
.SetInfo
End With

Debug.Print "Successfully created NT Account for user " & UserName
Create_NT_Account = True
Exit Function

Create_NT_Account_Error:

Debug.Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred creating NT account for user " & UserName

End Function

Public Function Create_Exchange_MailBox( _
IsRemote As Boolean, _
strServer As String, _
strDomain As String, _
strAdmin As String, _
strPassword As String, _
UserName As String, _
EMailAddress As String, _
strFirstName As String, _
strLastName As String, _
ExchangeServer As String, _
ExchangeSite As String, _
ExchangeOrganization As String _
) As Boolean

Dim Container As IADsContainer
Dim strRecipContainer As String
Dim Mailbox As IADs
Dim rbSID(1024) As Byte
Dim OtherMailBox() As Variant
Dim sSelfSD() As Byte
Dim encodedSD() As Byte
Dim I As Integer

Dim oNS As IADsOpenDSObject

'On Error GoTo Create_Exchange_MailBox_Error

Create_Exchange_MailBox = False

' Recipients container for this server
strRecipContainer = "LDAP://" & ExchangeServer & _
"/CN=Recipients,OU=" & ExchangeSite & _
",O=" & ExchangeOrganization
Set oNS = GetObject("LDAP:&quot

If (strPassword = "&quot Then
Set Container = GetObject(strRecipContainer)
Else
Set Container = oNS.OpenDSObject(strRecipContainer, "cn=" & strAdmin & ",dc=" & strDomain, strPassword, 0)
End If

' This creates both mailboxes or remote dir entries
If IsRemote Then
Set Mailbox = Container.Create("Remote-Address", "CN=" & UserName)
Mailbox.Put "Target-Address", EMailAddress
Else
Set Mailbox = Container.Create("OrganizationalPerson", "CN=" & UserName)
Mailbox.Put "MailPreferenceOption", 0
End If

With Mailbox
.SetInfo

' As an example two other addresses
ReDim OtherMailBox(1)
OtherMailBox(0) = "MS$" & ExchangeOrganization & _
"/" & ExchangeSite & _
"/" & UserName

OtherMailBox(1) = "CCMAIL$" & UserName & _
" at " & ExchangeSite

If Not (IsRemote) Then
' Get the SID of the previously created NT user
Get_Exchange_Sid strDomain, UserName, rbSID
.Put "Assoc-NT-Account", rbSID
' This line also initialize the "Home Server" parameter of the Exchange admin
.Put "Home-MTA", "cn=Microsoft MTA,cn=" & ExchangeServer & ",cn=Servers,cn=Configuration,ou=" & ExchangeSite & ", o = " & ExchangeOrganization
.Put "Home-MDB", "cn=Microsoft Private MDB,cn=" & ExchangeServer & ",cn=Servers,cn=Configuration,ou=" & ExchangeSite & ",o=" & ExchangeOrganization
.Put "Submission-Cont-Length", OUTGOING_MESSAGE_LIMIT
.Put "MDB-Use-Defaults", False
.Put "MDB-Storage-Quota", WARNING_STORAGE_LIMIT
.Put "MDB-Over-Quota-Limit", SEND_STORAGE_LIMIT
.Put "MAPI-Recipient", True

' Security descriptor
' The rights choosen make a normal user role
' The other user is optionnal, delegate for ex.

Call MakeSelfSD(sSelfSD, _
strServer, _
strDomain, _
UserName, _
UserName, _
RIGHT_MAILBOX_OWNER + RIGHT_SEND_AS + _
RIGHT_MODIFY_USER_ATTRIBUTES _
)

ReDim encodedSD(2 * UBound(sSelfSD) + 1)
For I = 0 To UBound(sSelfSD) - 1
encodedSD(2 * I) = AscB(Hex$(sSelfSD(I) \ &H10))
encodedSD(2 * I + 1) = AscB(Hex$(sSelfSD(I) Mod &H10))
Next I

.Put "NT-Security-Descriptor", encodedSD
Else

ReDim Preserve OtherMailBox(2)
OtherMailBox(2) = EMailAddress
.Put "MAPI-Recipient", False
End If

.PutEx ADS_PROPERTY_UPDATE, "otherMailBox", OtherMailBox

.Put "TextEncodedORaddress", "c=" & COUNTRY & _
";a= " & _
";p=" & ExchangeOrganization & _
";o=" & ExchangeSite & _
";s=" & strLastName & _
";g=" & strFirstName & _
";i=" & Mid(strFirstName, 1, 1) & Mid(strLastName, 1, 1) & ";"

.Put "Mail", EMailAddress

.Put "uid", UserName

.Put "GivenName", strFirstName
.Put "Sn", strLastName
.Put "Cn", strFirstName & " " & strLastName
.Put "Initials", Mid(strFirstName, 1, 1) & Mid(strLastName, 1, 1)

' Any of these fields are simply descriptive and optional, not included in
' this sample and there are many other fields in the mailbox

' .Put "Deliv-Cont-Length", INCOMING_MESSAGE_LIMIT
' i : initials

'If 0 < Len(Direction) Then .Put &quot;Department&quot;, Direction
'If 0 < Len(FaxNumber) Then .Put &quot;FacsimileTelephoneNumber&quot;, FaxNumber
'If 0 < Len(City) Then .Put &quot;l&quot;, City
'If 0 < Len(Address) Then .Put &quot;PostalAddress&quot;, Address
'If 0 < Len(PostalCode) Then .Put &quot;PostalCode&quot;, PostalCode
'If 0 < Len(Banque) Then .Put &quot;Company&quot;, Banque
'If 0 < Len(PhoneNumber) Then .Put &quot;TelephoneNumber&quot;, PhoneNumber
'If 0 < Len(Title) Then .Put &quot;Title&quot;, Title
'If 0 < Len(AP1) Then .Put &quot;Extension-Attribute-1&quot;, AP1

.SetInfo
End With

Debug.Print &quot;Successfully created mailbox for user &quot; & UserName
Create_Exchange_MailBox = True
Exit Function

Create_Exchange_MailBox_Error:

Debug.Print &quot;Error 0x&quot; & CStr(Hex(Err.Number)) & &quot; occurred creating Mailbox for user &quot; & UserName

End Function

 

[cruford]

I changed the line in red from the post before to:

Set Container = oNS.OpenDSObject(strRecipContainer, strDomain & &quot;\&quot; & strAdmin, strPassword, 0)

And now im getting &quot;Automation Error: Login Failure, bad username or password&quot;

Not sure why it's saying bad login. I am able to connect to the exchange administrator and create/edit/delete mailboxes fine through the GUI.

 

[cruford]

Paulbent thanks for you responses. I figured out where I was going wrong. I was passing the wrong value for the OU. So of course it was failing to automate the process. Thanks again for the help.

 

[paulbent]

Glad to hear it's all working now. Thanks for the star!

Paul Bent
Northwind IT Systems

http://www.northwindit.co.uk