Using Outlook Library to extract SMTP addresses
| I want to retrieve the SMTP addresses from address
| entries in my global address list using the outlook
| library.
|
| I can access all of the address entries just fine. I can
| read the names, etc. But, when I read the address
| property from my address entry (as an example), I get:
|
| /o=DORISINC/ou=first administrative
| group/cn=Recipients/cn=RaneyE
|
| address)! I have looked through the object library and
| cannot find this anywehre!
|
| Please help ... I am desperate!!!
|
| Thanks,
| Raney
Hi Raney,
I experimented with extracting SMTP addresses from the GAL on our Exchange
Server several months ago. It's probably not the way you wanted to do it,
but it may give you ideas.
'Enum ActMsgDisplayType
Const ActMsgUser = 0
Const ActMsgDistList = 1
Const ActMsgForum = 2
Const ActMsgAgent = 3
Const ActMsgOrganization = 4
Const ActMsgPrivateDistList = 5
Const ActMsgRemoteUser = 6
Const CdoPR_EMS_AB_HOME_MTA = &H8007001E
Const CdoPR_EMS_AB_PROXY_ADDRESSES = &H800F101E
Public Sub AddressBooks()
Dim objSession As Object 'MAPI.Session
Dim collAddressEntries As Object 'AddressEntries
On Error GoTo error_olemsg
' create a session and log on
Set objSession = CreateObject("MAPI.Session")
' use a valid exchange profile name
objSession.Logon "Microsoft Outlook"
' Walk the Global Address List
Set collAddressEntries = objSession.AddressLists("Global Address
List").AddressEntries
WalkAddressList collAddressEntries
'close session and logoff
objSession.Logoff
Exit Sub
error_olemsg:
MsgBox "Error " & Str(Err) & ": " & Error$(Err)
End Sub
Private Sub WalkAddressList(collAddressEntries As Object)
' Walk an AddressEntries collection recursively expanding Distribution
Lists
On Error Resume Next
Dim objAddressEntry As Object 'AddressEntry
Dim objField As Object 'Field
Dim n As Long
Dim v As Variant
Dim sName As String
Dim sAddress As String
Dim sType As String
Dim sSMTP As String
Dim s As String
For Each objAddressEntry In collAddressEntries
s = ""
If objAddressEntry.DisplayType = ActMsgUser Then
' Display the recipient's name
sName = Trim$(objAddressEntry.Name)
Select Case True
Case InStr(sName, "(E-mail") > 0
Debug.Print sName,
s = s & sName & vbTab
Case InStr(sName, "(Business Fax") > 0
sName = ""
Case InStr(sName, "(Other Fax") > 0
sName = ""
Case Else
Debug.Print sName,
s = s & sName & vbTab
End Select
If Len(sName) Then
sAddress = Trim$(objAddressEntry.Address)
If InStr(sAddress, "/o=") > 0 Then
sSMTP = ""
Else
sSMTP = sAddress 'is this a valid
e-mail address?
Debug.Print sAddress,
s = s & sSMTP & vbTab
End If
'Q196507
' Get the PR_EMS_AB_PROXY_ADDRESSES property.
Set objField =
objAddressEntry.Fields(CdoPR_EMS_AB_PROXY_ADDRESSES)
If Err = 0 Then
' PR_EMS_AB_PROXY_ADDRESSES is a multivalued property
(PT_MV_TSTRING).
' Therefore, you need to extract the individual members.
For Each v In objField.Value
n = InStr(v, ":")
If n > 0 Then
sType = Left$(v, n - 1)
If sType = "SMTP" Then
sSMTP = Trim$(Mid$(v, n + 1))
Debug.Print sSMTP,
s = s & sSMTP & vbTab
End If
End If
Next
End If
Debug.Print
End If
ElseIf objAddressEntry.DisplayType = ActMsgDistList Then
WalkAddressList objAddressEntry.Members
End If
If Len(s) Then
'AppendToFile App.Path & "\gal.txt", s
End If
Next objAddressEntry
End Sub
