The information in this article applies to: |
- Microsoft Outlook 2000,2002,XP,2003 |
对于Outlook邮件中的收件人一栏,如果收件人属于公司内部用户,直接用MailItem.Recipents.Item(nRecipentIndex).Address字段得到的邮件地址是X400地址,要求转换为SMTP邮件地址。
我经过试验,有以下两种办法做这种转换:
第一个:使用共享软件Redemption;
第二个:直接用ADO在Active Directory中查询。
对于第一种办法,需要像注册普通COM组件一样注册Redemption.DLL。
这个组件可以在
http://www.dimastr.com/redemption/
下载。
但是,这个组件分为两种版本:Developer Version和Distributable Version。前者不允许从事商业行为,后者购买需要199美元。
使用它得到SMTP邮件地址的办法在
http://www.outlookcode.com/d/code/getsenderaddy.htm#redemption
说得很明白了,我下面只是给出一个类似的R_GetSenderAddress方法:
Private Function R_GetSenderAddress(ByRef oSafeMailItem, ByVal nRecipentIndex) As String Dim strType Dim objSenderAE As Redemption.AddressEntry
Const PR_SENDER_ADDRTYPE = &HC1E001E Const PR_EMAIL = &H39FE001E
Set objSenderAE = oSafeMailItem.Recipients.Item(nRecipentIndex).AddressEntry If Not objSenderAE Is Nothing Then strType = objSenderAE.Type If strType = "SMTP" Then R_GetSenderAddress = objSenderAE.Address ElseIf strType = "EX" Then R_GetSenderAddress = objSenderAE.Fields(PR_EMAIL) End If End If
Set objSenderAE = Nothing End Function |
对于第二种办法,可能麻烦一点,其运行效率还和Active Directory有关。由于这种ADO Query AD原理非常简单,所以我就直接用代码说明了:
' 方法解释: ' 方法名:R_GetSenderAddress ' 功能:从X400的邮件地址解析出用户的SMTP邮件地址 ' 由于Exchange Server User的邮件地址类型是EX,而且展现为 ' /O=TOMORROW/OU=TRT/CN=RECIPIENTS/CN=Zhengyun ' 形式。 ' 我们需要把这个地址转换为SMTP地址,但是由于OutlookLibrary并没有提供这一功能, ' 所以我必须自己去AD查询了 Private Function R_GetSenderAddress(ByRef strX400Address) As String Dim oRootDSE 'As IADs Dim objUser ' As IADsUser ' ' 以下注意,connection,command对象不能用createobject创建,否则查询不出来 ' 只能new了! Dim oConnection As New ADODB.Connection Dim oCommand As New ADODB.Command ' Dim RS ' As ADODB.Recordset Dim strQuery As String, strAlias As String Dim varDomainNC As Variant
On Error Resume Next ' To do: change to the alias for the mailbox you are looking for. Dim arrX400 arrX400 = Split (UCase$(strX400Address), "/CN=")
' 取到最后的用户的姓名: strAlias = arrX400(UBound(arrX400))
If Len(strAlias) > 0 Then ' Get the Configuration Naming Context. Set oRootDSE = GetObject("LDAP://RootDSE") varDomainNC = oRootDSE.Get("defaultNamingContext") ' Open the Connection oConnection.Provider = "ADsDSOObject" oConnection.Open "ADs Provider"
' Build the query to find the user based on their alias. strQuery = "
oCommand.ActiveConnection = oConnection oCommand.CommandText = strQuery Set RS = oCommand.Execute
If RS.RecordCount = 0 Then R_GetSenderAddress = "" Else ' Iterate through the results. Do Set objUser = GetObject(RS.Fields("adspath")) ' 拿到了他的真正SMTP邮件地址: R_GetSenderAddress = objUser.EmailAddress Set objUser = Nothing Exit Do Loop While RS.EOF End If Else R_GetSenderAddress = "" End If
Set oRootDSE = Nothing Set oCommand = Nothing Set oConnection = Nothing Set RS = Nothing On Error GoTo 0 End Function |
Writen by zhengyun.NoJunk(at)gmail.dot.com
Disclaimers:
Programmer’s Blog List: |
|
|
本文档仅供参考。本文档所包含的信息代表了在发布之日,zhengyun对所讨论问题的当前看法,zhengyun不保证所给信息在发布之日以后的准确性。
用户应清楚本文档的准确性及其使用可能带来的全部风险。可以复制和传播本文档,但须遵守以下条款:
- 复制时不得修改原文,复制内容须包含所有页 ;
- 所有副本均须含有 zhengyun的版权声明以及所提供的其它声明 ;
- 不得以赢利为目的对本文档进行传播 。
Trackback: http://tb.blog.csdn.net/TrackBack.aspx?PostId=36393