sp; strPassword As String, _
UserName As String _
) As Boolean
Dim Domain As IADsDomain
Dim oNS As IADsOpenDSObject
On Error GoTo Delete_NT_Account_Error
Delete_NT_Account = False
If (strPassword = "") Then
strPassword = ""
End If
Set oNS = GetObject("WinNT:")
Set Domain = oNS.OpenDSObject("WinNT://" & strDomain, strDomain & "\" & strAdmin, strPassword, 0)
Domain.Delete "User", UserName
Debug.Print "Successfully deleted NT Account for user " & UserName
Delete_NT_Account = True
Exit Function
Delete_NT_Account_Error:
Debug.Print "Error 0x" & CStr(Hex(Err.Number)) & " occurred deleting NT account for user " & UserName
End Function
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''
'' Create_Exchange_Mailbox() -- creates an Exchange mailbox, sets mailbox
'' properties and and associates the mailbox with
'' an existing NT user account
''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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, _
strPwd As String, _
strRealName 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 = "") Then
strPassword = ""
End If
' Recipients container for this server
strRecipContainer = "LDAP://" & ExchangeServer & _
"/CN=Recipients,OU=" & ExchangeSite & _
",O=" & ExchangeOrganization
Set oNS = GetObject("LDAP:")
Set Container = oNS.OpenDSObject(strRecipContainer, "cn=" & strAdmin & ",dc=" & strDomain, strPassword, 0)
' 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
' Usng PutEx for array properties
.PutEx ADS_PROPERTY_UPDATE, "otherMailBox", OtherMailBox
.Put "Deliv-Cont-Length", INCOMING_MESSAGE_LIMIT
' i : initials
.Put "TextEncodedORaddress", "c=" & COUNTRY & _
";a= " & _
";p=" & ExchangeOrganization & _
";o=" & ExchangeSite & _
";s=" & strLastName & _
";g=" & strFirstName & _
";i=" & Mid(strFirstName, 1, 1) & Mid(strLastName, 1, 1) & ";"
.Put "rfc822MailBox", UserName & "@" & Exchange上一页 [1] [2] [3] [4] [5] 下一页
|
评论
收藏
分享
打印
