Set OL = CreateObject("Outlook.Application")
Set OM = OL.GetNamespace("MAPI")
MsgBox OM.Accounts.Item(1).SmtpAddress

Sub Main()
    Call AD_Get_Info("Ivanov", "Ivan")
End Sub

Function AD_Get_Info(ByVal sFirst As String, sLast As String) As Variant
'Get specific AD/LDAP user info for a given first and last name.

Dim oCmd As Object, oConn As Object, oRecSet As Object, objField As Object

'Set up ADO query and excute to find group matches
Set oCmd = CreateObject("ADODB.Command")
Set oConn = CreateObject("ADODB.Connection")
Set oRecSet = CreateObject("ADODB.Recordset")
oConn.Open "Provider=ADsDSOObject;"
'What to get and filter criteria
oCmd.CommandText = "SELECT mail, distinguishedname, name, samaccountname from 'LDAP://" & GetNC & "' WHERE objectCategory = 'user' and sn = '" & sLast & "' and givenName = '" & sFirst & "'"
oCmd.activeconnection = oConn
Set oRecSet = oCmd.Execute  'Go get the info if it exists!
If oRecSet.EOF = True And oRecSet.BOF = True Then Exit Function  'Nothing found
For Each objField In oRecSet.Fields
    Debug.Print objField.Name & " = " & objField.Value
    DoEvents
Next objField

oConn.Close
Set oRecSet = Nothing
Set oConn = Nothing
Set oCmd = Nothing

End Function

Function GetNC()
Dim objRoot As Object
    Set objRoot = GetObject("LDAP://RootDSE")
    GetNC = objRoot.get("defaultNamingContext")
    Set objRoot = Nothing
End Function