Option Explicit
' This constant is not included in the CDO (1.x) type library,
' so you must declare it explicitly or use the provided
' value directly.
Const CdoPR_EMS_AB_PROXY_ADDRESSES = &H800F101E
Private Sub Command1_Click()
Dim objSession As MAPI.Session
Dim objMessage As MAPI.Message
Dim objRecip As MAPI.Recipient
Dim objField As MAPI.Field
Dim v, strReturnValue, empfaenger
Dim i As Integer
On Error GoTo ERROR_HANDLER
empfaenger = ""
' Create Session object and Logon.
Set objSession = CreateObject("MAPI.Session")
objSession.Logon "Outlook", "password", False
' Show AddressBook and choose a recipient.
Set objMessage = objSession.Outbox.Messages.Add
Set objMessage.Recipients = objSession.AddressBook(OneAddress:=True)
For i = 1 To objMessage.Recipients.Count
Set objRecip = objMessage.Recipients(i)
' Get the PR_EMS_AB_PROXY_ADDRESSES property.
Set objField = objRecip.AddressEntry.Fields(CdoPR_EMS_AB_PROXY_ADDRESSES)
For Each v In objField.Value
If InStr(1, v, "SMTP:") Then
strReturnValue = Mid(v, 6, 256)
If empfaenger <> "" Then
empfaenger = empfaenger & "; " & strReturnValue
Else
empfaenger = strReturnValue
End If
Exit For
End If
Next
Next
Form1.Text1 = empfaenger
' Clean up
Set objMessage = Nothing
Set objRecip = Nothing
Set objField = Nothing
objSession.Logoff
Set objSession = Nothing
ERROR_HANDLER:
If (InStr(Err.Description, "MAPI_E_USER_CANCEL") > 0) Then
MsgBox "Keine Adresse ausgewählt!", vbInformation, "Info"
ElseIf (Err.Description <> "") Then
MsgBox "unerwarteter Fehler", vbCritical, "Error"
End If
End Sub