Search outlook exchange for email address

[dmeehanjr]

I'm trying to see if can search outlook exchange from access vba to get email address (using windows user name) / Anyone with experience doing?
Thanks!
Don

 

[TJPoorman]

This code isn't very clean, but it should do exactly what you're looking for.
Just need to change the domain in the SQL statement.

Public Function GetUserEmail(strDisplayName As String) As String
'*****************************************
'*Connects To AD and sets search criteria*
'*****************************************
Dim objConnection As Object
Dim objCommand As Object
Dim objRecordset As Object

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand = CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"
Set objCommand.ActiveConnection = objConnection
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = 2

'************************************************* *********************
'*SQL statement on what OU to search and to look for User Objects ONLY*
'************************************************* *********************
objCommand.CommandText = _
"SELECT DisplayName, Mail, sAMAccountName " _
& "FROM 'LDAP://domain.com' WHERE " _
& "objectCategory='user' " _
& "AND DisplayName = '*" & strDisplayName & "*'"

Set objRecordset = objCommand.Execute
With objRecordset
    .MoveFirst
    Do While Not .EOF
        Debug.Print .Fields("sAMAccountName").Value & ";" & _
        StrConv(.Fields("DisplayName").Value, 3) & ";" & _
        .Fields("Mail").Value & ";" & _
        .MoveNext
    Loop
End With

objRecordset.Close
Set objRecordset = Nothing
End Function