用程序创建用户邮箱？一个有挑战性的问题

lishush · 发表于 2004-8-24 13:51:36

我现在想通过程序在Exchange Server中创建用户邮箱，在MSDN中找到了一段代码，但一直都不可用，不知道这里的兄弟又没有人用过，帮我一把！ 
VB代码如下： 
 
引用类库：Active DS Type Library, Microsoft CDO for Exchange Management Library, Microsoft Cluster Service Automation Classes, Microsoft CDO for Windows 2000 Library. 
 
Form中： 
Private Sub Command1_Click() Dim szServerName As String Dim szDomainName As String Dim szExchangeOrg As String Dim szAdminGroup As String Dim szStorageGroup As String Dim szstoreName As String Dim szAlias As String Dim szFirstName As String Dim szLastName As String Dim szPassword As String Dim szHostingOrgName As String Dim szHostingOrgDomain As String Dim szOrganizationalUnit As String Dim szGroupName As String Dim szDirectoryServer As String Dim szAdminUserName As String Dim szAdminPassword As String 
' Input: szServerName: Name of Exchange server 
' szdomainName: Domain of user 
' szExchangeOrg: Name of Exchange organization 
' szAdminGroup: Name of Exchange admin group 
' szStorageGroup: Name of Exchange storage group 
' szstoreName: Name of the store the mailbox is to be created in 
' szAlias: Alias of user 
' szFirstName: First name of user 
' szLastName: Last name of user 
' szPassword: User's password 
' szHostingOrgName: Name of hosting container in the DS 
' szHostingOrgDomain: SMTP suffix of user's org 
' szOrganizationalUnit: Name of users org 
' szGroupName: Name of group to add user to 
' szDirectoryServer: Name of the Directory Server 
' szAdminUserName: Administrator user name 
' szAdminPassword: Administrator password 
 szServerName = "exchange" szDomainName = "exchange.com" szExchangeOrg = "First Organization" szAdminGroup = "administrators" szStorageGroup = "First Storage Group" szstoreName = "Mailbox Store(EXCHANGE)" szAlias = "" szFirstName = "user" szLastName = "li" szPassword = "user" szHostingOrgName = "exchange" szHostingOrgDomain = "exchange.com" szOrganizationalUnit = "" szGroupName = "" szDirectoryServer = "exchange" szAdminUserName = "" szAdminPassword = "" Call createUserThroughCDO(szServerName, _ szDomainName, _ szExchangeOrg, _ szAdminGroup, _ szStorageGroup, _ szstoreName, _ szAlias, _ szFirstName, _ szLastName, _ szPassword, _ szHostingOrgName, _ szHostingOrgDomain, _ szOrganizationalUnit, _ szGroupName, _ szDirectoryServer, _ szAdminUserName, _ szAdminPassword) 
 
End Sub 
 
module 中的代码： 
'////////////////////////////////////////////////////////////////////// 
' Function: createUserThroughCDO() 
' Purpose: Creates a user in the specified organization, assigns an offline address book, 
' sets their Outlook Web Access search criteria, and creates a mailbox. 
' 
' Input: szServerName: Name of Exchange server 
' szdomainName: Domain of user 
' szExchangeOrg: Name of Exchange organization 
' szAdminGroup: Name of Exchange admin group 
' szStorageGroup: Name of Exchange storage group 
' szstoreName: Name of the store the mailbox is to be created in 
' szAlias: Alias of user 
' szFirstName: First name of user 
' szLastName: Last name of user 
' szPassword: User's password 
' szHostingOrgName: Name of hosting container in the DS 
' szHostingOrgDomain: SMTP suffix of user's org 
' szOrganizationalUnit: Name of users org 
' szGroupName: Name of group to add user to 
' szDirectoryServer: Name of the Directory Server 
' szAdminUserName: Administrator user name 
' szAdminPassword: Administrator password 
' 
' Output: createUserThroughCDO: Contains Error code (if any) 
' 
' Note: In order for this example to function correctly, it may be necessary to include 
' references to the following libraries: Active DS Type Library, Microsoft CDO for 
' Exchange Management Library, Microsoft Cluster Service Automation Classes, 
' Microsoft CDO for Windows 2000 Library. 
'////////////////////////////////////////////////////////////////////// 
Public Function createUserThroughCDO(ByVal szServerName As String, _ ByVal szDomainName As String, _ ByVal szExchangeOrg As String, _ ByVal szAdminGroup As String, _ ByVal szStorageGroup As String, _ ByVal szstoreName As String, _ ByVal szAlias As String, _ ByVal szFirstName As String, _ ByVal szLastName As String, _ ByVal szPassword As String, _ ByVal szHostingOrgName As String, _ ByVal szHostingOrgDomain As String, _ ByVal szOrganizationalUnit As String, _ ByVal szGroupName As String, _ ByVal szDirectoryServer, _ ByVal szAdminUserName, _ ByVal szAdminPassword) As Integer 
 Dim objPerson As CDO.Person Dim objMailbox As cdoexm.IMailboxStore Dim szConnString As String Dim szOABlocation As String Dim szLdapDomain As String Dim szaDomTokens() As String Dim szDomainDN As String 
 On Error GoTo errhandler 
 ' Puts the domain specified into an ldap domain string. szaDomTokens = Split(szDomainName, ".", -1, 1) szDomainDN = Join(szaDomTokens, ",dc=") szDomainDN = "dc=" & szDomainDN szLdapDomain = szDomainDN 
 ' Build the necessary LDAP path to create the user. szConnString = "LDAP://" + szDirectoryServer + "/" + _ "cn=" + szAlias + ",OU=" + szOrganizationalUnit + _ ",OU=" + szHostingOrgName + "," + szLdapDomain 
 ' Build the necessary LDAP path to this users's OAB's. 
 szOABlocation = "cn=" + szOrganizationalUnit + _ ",cn=Offline Address Lists,cn=Address Lists Container,cn=" + _ szExchangeOrg + ",cn=Microsoft Exchange,cn=Services,cn=Configuration," + szLdapDomain 
 ' First, create the user in Active Directory. 
 Set objPerson = CreateObject("CDO.Person") With objPerson .FirstName = szFirstName .LastName = szLastName .Fields("sAMAccountName") = szAlias + "@" + szHostingOrgDomain .Fields("userPrincipalName") = szAlias + "@" + szHostingOrgDomain .Fields("userAccountControl") = 66048 ' set password doesn't expire .Fields("userPassword") = szPassword .Fields("msexchQueryBaseDN") = "OU=" + szOrganizationalUnit + "," + "OU=" + szHostingOrgName + "," + szLdapDomain .Fields("mailNickname") = szAlias .Fields("msExchUseOAB") = szOABlocation .Fields.Update MsgBox .DataSource.SourceURL .DataSource.SaveTo szConnString, , , , , szAdminUserName, szAdminPassword End With 
 ' Create the mailbox in the specified location. 
 Set objMailbox = objPerson.GetInterface("IMailboxStore") objMailbox.CreateMailbox "LDAP://" + szDirectoryServer + _ "/CN=" + szstoreName + ",CN=" + szStorageGroup + _ ",CN=InformationStore,CN=" + szServerName + _ ",CN=Servers,CN=" + szAdminGroup + _ ",CN=Administrative Groups,CN=" + szExchangeOrg + _ ",CN=Microsoft Exchange,CN=Services,CN=Configuration," + _ szLdapDomain With objPerson .Email = szAlias + "@" + szHostingOrgDomain .DataSource.Save End With 
 ' See if a group name was passed in. If so, add this user to that group. 
 If szGroupName <> "" Then addUserToGroup szDomainName, _ szAlias, _ szGroupName, _ szHostingOrgName, _ szOrganizationalUnit, _ szHostingOrgDomain, _ True, _ szAdminUserName, _ szAdminPassword, _ szDirectoryServer End If 
 createUserThroughCDO = 0 
 ' Clean up. Set objPerson = Nothing Set objMailbox = Nothing Exit Function 
 ' Error handling. 
errhandler: 
 createUserThroughCDO = 1 ' Implement error logging here. MsgBox Err.Description & " " & Err.Number Set objPerson = Nothing Set objMailbox = Nothing 
 
End Function 
 
'////////////////////////////////////////////////////////////////////// 
' Function: addUserToGroup() 
' Purpose: Adds the specified user (or group) to the specified group. 
' 
' Input: szDomainName: Domain of the Exchange org 
' szUserAlias: Alias of user (or group) to add 
' szGroupAlias: Name of Exchange organization 
' szHostingOrgName: Name of hosting container 
' szOrganizationalUnit: Name of hosting organization 
' szSMTPAddress: SMTP address of user & group 
' boolUser: User or group? T/F 
' szUserName: Admin username 
' szUserPwd: Admin pwd 
' szDirectoryServer: Name of the Directory Server 
' 
' Output: addUserToGroup: Contains Error code (if any) 
' 
' Note: In order for this example to function correctly, it may be necessary to include 
' references to the following libraries: Active DS Type Library, Microsoft CDO for 
' Exchange Management Library, Microsoft Cluster Service Automation Classes, 
' Microsoft CDO for Windows 2000 Library. 
'////////////////////////////////////////////////////////////////////// 
Public Function addUserToGroup(ByVal szDomainName As String, _ ByVal szUserAlias As String, _ ByVal szGroupAlias As String, _ ByVal szHostingOrgName As String, _ ByVal szOrganizationalUnit As String, _ ByVal szSMTPAddress As String, _ ByVal boolUser As Boolean, _ ByVal szUserName As String, _ ByVal szUserPwd As String, _ ByVal szDirectoryServer) As Integer 
 Dim szLdapDomain As String Dim szConnStringGroup As String Dim szConnStringUser As String Dim objGrp As IADs Dim objUsr As IADs Dim objLdap As IADsOpenDSObject Dim szaDomTokens() As String Dim szDomainDN As String 
 On Error GoTo errhandler 
 ' Puts the domain specified into an ldap domain string. szaDomTokens = Split(szDomainName, ".", -1, 1) szDomainDN = Join(szaDomTokens, ",dc=") szDomainDN = "dc=" & szDomainDN szLdapDomain = szDomainDN 
 ' Create the ldap path for the group. szConnStringGroup = "LDAP://" + szDirectoryServer + _ "/cn=" + szGroupAlias + "@" + szSMTPAddress + _ ",OU=" + szOrganizationalUnit + ",OU=" + _ szHostingOrgName + "," + szLdapDomain 
 ' Create the ldap path for the object to ADD to the group. If boolUser Then szConnStringUser = "LDAP://" + szDirectoryServer + _ "/cn=" + szUserAlias + ",OU=" + szOrganizationalUnit + _ ",OU=" + szHostingOrgName + "," + szLdapDomain Else szConnStringUser = "LDAP://" + szDirectoryServer + _ "/cn=" + szUserAlias + "@" + szSMTPAddress + _ ",OU=" + szOrganizationalUnit + ",OU=" + _ szHostingOrgName + "," + szLdapDomain End If 
 ' Get handles to the objects. 
 Set objLdap = GetObject("LDAP:") 
 Set objGrp = objLdap.OpenDSObject(szConnStringGroup, _ szUserName, _ szUserPwd, _ ADS_SECURE_AUTHENTICATION) 
 Set objUsr = objLdap.OpenDSObject(szConnStringUser, _ szUserName, _ szUserPwd, _ ADS_SECURE_AUTHENTICATION) 
 ' Join the user/group to the group. 
 With objGrp .Add objUsr.ADsPath .SetInfo End With 
 addUserToGroup = 0 
 ' Clean up. Set objGrp = Nothing Set objUsr = Nothing Set objLdap = Nothing Exit Function 
 ' Error handling. 
errhandler: 
 addUserToGroup = 1 ' Implement error handling here. Set objGrp = Nothing Set objUsr = Nothing Set objLdap = Nothing 
 
End Function

lishush · 发表于 2004-8-24 13:58:04

只要将Form中的代码复制到Form 模块中，将Module 块的代码复制到Module中，引用以上的类库，添加一个Command1 按钮就可以运行了。 
 
但我这里一直都报 Unknow error 错误，不知道是什么原因。 
 
方法都是MSDN中复制过来的，应该没有什么错误，估计是参数的问题，但我按照他的注释加入参数的（有些不知道怎么加），问题就在这里，希望各位兄弟帮帮忙啊！

yinjie · 发表于 2004-8-24 18:29:25

很多的变量需要替换成实际的值

lishush · 发表于 2004-8-25 12:28:23

这是一个函数阿，只要传入实际的值就可以了

yinjie · 发表于 2004-8-25 14:27:03

我知道是函数。这些值FORM里指定，你定义了吗？（所有参数都需要定义！！） 
szServerName = "exchange" szDomainName = "exchange.com" szExchangeOrg = "First Organization" szAdminGroup = "administrators" szStorageGroup = "First Storage Group" szstoreName = "Mailbox Store(EXCHANGE)" szAlias = "" szFirstName = "user" szLastName = "li" szPassword = "user" szHostingOrgName = "exchange" szHostingOrgDomain = "exchange.com" szOrganizationalUnit = "" szGroupName = "" szDirectoryServer = "exchange" szAdminUserName = "" szAdminPassword = ""

lishush · 发表于 2004-8-27 10:13:09

是LDAP的字符串中出现了问题

		自动登录	找回密码
密码			会员注册

用程序创建用户邮箱？一个有挑战性的问题

re:只要将Form中的代码复制到Form 模...

re:很多的变量需要替换成实际的值

re:这是一个函数阿，只要传入实际的值就可以了

re:我知道是函数。这些值FORM里指定，你定...

re:是LDAP的字符串中出现了问题

浏览过的版块