HOW TO: Obtain the Domain and Account Information from a Mailbox Account in Outlook 2000 (318567)

SUMMARY

If you know a user's mailbox account, you can obtain the user's domain and account information. The code necessary to perform this task uses the CDO 1.21 library.

Required Hardware and Software

• Outlook 2000

back to the top

Obtain the Domain and Account Information

1. Start Outlook. On the Tools menu, point to Macro, and then click Visual Basic Editor.
2. In the Project - Project1 pane, double-click Project1, and then double-click Microsoft Outlook Objects.
3. Double-click ThisOutlookSession to open a code window.
4. On the Tools menu, click Reference, and then click Microsoft CDO 1.21 library.
5. In the code window, type or paste the following code:

   Private Declare Function LookupAccountSid Lib "advapi32.dll" Alias "LookupAccountSidA" ( _
       ByVal lpSystemName As String, _
       Sid As Any, _
       ByVal name As String, _
       cbName As Long, _
       ByVal ReferencedDomainName As String, _
       cbReferencedDomainName As Long, _
       peUse As Integer _
   ) As Long
   
   'NOTE: This constant is not defined by CDO.
   Const CdoPR_EMS_AB_ASSOC_NT_ACCOUNT = &H80270102
   
   Private Sub GetNTAccountInfo()
   Dim objSession As New MAPI.Session
   Dim objMessage As MAPI.Message
   Dim objRecip As MAPI.Recipient
   Dim bByte() As Byte
   Dim tmp As Integer
   Dim i As Integer
   Dim ret As Boolean
   Dim rmtCmp As String
   Dim strSID As String
   Dim strName As String
   Dim strDomain As String
     
   On Error GoTo Finish
   
   objSession.Logon
   
   Set objMessage = objSession.Outbox.Messages.Add
   Set objMessage.Recipients = objSession.AddressBook(OneAddress:=True)
   If objMessage.Recipients Is Nothing Then
       MsgBox "No recipient has been chosen!"
       objSession.Logoff
       Exit Sub
   End If
   Set objRecip = objMessage.Recipients(1)
   
   'Make sure it's a mailbox.
   If Not objRecip.DisplayType = CdoUser Then
       MsgBox "Selection is not a mailbox owner"
       GoTo Finish
   End If
   
   'Get the PR_EMS_AB_ASSOC_NT_ACCOUNT (&H80270102) field.
   strSID = objRecip.AddressEntry.Fields(CdoPR_EMS_AB_ASSOC_NT_ACCOUNT).Value
   
   'The SID is stored in a hexadecimal representation of the binary SID,
   'so we convert it and store it in a byte array.
   tmp = Len(strSID) / 2 - 1
   ReDim bByte(tmp) As Byte
   For i = 0 To tmp - 1
   bByte(i) = CInt("&h" & Mid(strSID, (i * 2) + 1, 2))
   Debug.Print bByte(i)
   Next
   
   'You can replace the name with your Exchange Server name.
   rmtCmp = "ExchangeServer_Name" 
   
   strName = Space(64)
   strDomain = Space(64)
   
   ret = LookupAccountSid(rmtCmp, bByte(0), strName, _
   Len(strName), strDomain, Len(strDomain), iType)
   
   If ret Then
       strDomain = Left(strDomain, InStr(strDomain, Chr(0)) - 1)
       strName = Left(strName, InStr(strName, Chr(0)) - 1)
       MsgBox "NT Account: " & strDomain & "\" & strName
   Else
       MsgBox "Error calling LookupAccountSID: " & ret
   End If
   
   Finish:
   If Err.Number = CdoE_USER_CANCEL Then
   Debug.Print "Cancel!!"
   End If
   
   objSession.Logoff
   Set objSession = Nothing
   End Sub
   					

6. Press F5 to run the program.

back to the top

Additional Information

This sample code requires the CDO 1.21 library. CDO 1.21 is included with Microsoft Outlook 98 and Outlook 2000.

For additional information about how to install CDO 1.21, click the article numbers below to view the articles in the Microsoft Knowledge Base: back to the top