Select one of Contact-Mailadesses to Export > Excel or Winword

Not open for further replies.


New Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
Hi, i need help for an VBA-Script in Outlook 2010. I find no Contactfield in VBA Contact.Item exists to export the currentitem selected Mailadress of an Outlook Contactform to Export > WinWord or Excel. Is there any way to an Diaolog to select or pic up one of the 3 Mailadresses of an Outlookcontact befor run the Export?


Greetings from Germany...
Hans Dieter


Diane Poremsky

Senior Member
Outlook version
Outlook 2016 32 bit
Email Account
Office 365 Exchange
I'm not sure I understand the problem, the 3 addresses are .Email1Address, .Email2Address, .Email3Address

This is from my "super duper bulk contacts" macro - it displays the name and email addresses of each contact in the default contacts folder.

Public Sub ChangeEmailDisplayName()
    Dim objOL As Outlook.Application
    Dim objNS As Outlook.NameSpace
    Dim objContact As Outlook.ContactItem
    Dim objItems As Outlook.Items
    Dim objContactsFolder As Outlook.MAPIFolder
    Dim obj As Object
    Dim strFirstName As String
    Dim strLastName As String
    Dim strFileAs As String
    On Error Resume Next
    Set objOL = CreateObject("Outlook.Application")
    Set objNS = objOL.GetNamespace("MAPI")
    Set objContactsFolder = objNS.GetDefaultFolder(olFolderContacts)
    Set objItems = objContactsFolder.Items
    For Each obj In objItems
        'Test for contact and not distribution list
        If obj.Class = olContact Then
            Set objContact = obj
          With objContact
             MsgBox .FullName & .Email1Address & .Email2Address & .Email3Address
          End With
        End If
    Set objOL = Nothing
    Set objNS = Nothing
    Set obj = Nothing
    Set objContact = Nothing
    Set objItems = Nothing
    Set objContactsFolder = Nothing
End Sub


New Member
Outlook version
Outlook 2010 32 bit
Email Account
Exchange Server
Hi Diana, many thanks for your request an your examplecode. I send you my code maybe you have an idea of an Workaround ;-) ? The Problem is... Some of Contacts have 2 or 3 Mailadresses. In this case i am not found a field in VBA
to pic up the selected Mailadress. To fix these Problem .... Show an dialog to pic up one of thes Mailadresses an give the value Email1Address or Email2Address or Email3Address to the Codesection...

If objContact.XXXX1 = 1 Then strFields(4) = objContact.Email1Address
If objContact.XXXX2 = 2 Then strFields(4) = objContact.Email2Address
If objContact.XXXX3 = 3 Then strFields(4) = objContact.Email3Address

In hope you/one have an idea to fix my Problem...
Greetings from Germany Hans Dieter

Public Sub KontaktWord()
Dim Fehler
Dim i As Integer
Dim strFields() As String
Dim strOutput As String
Dim strOutput1 As String
Dim strOutput2 As String
Dim strOutput3 As String
Dim strOutput4 As String
Dim objApp As Application
Dim objNS As NameSpace
Dim objWord As Word.Application
Dim objWordDoc As Word.Document
Dim pfad As String
Dim objContact As ContactItem

'Wenn Outlook und Kontakt nicht geöffnet, dann geht auch nicht!
On Error GoTo Ausgang
Set objApp = Outlook.Application
Set objNS = objApp.GetNamespace("MAPI")
Set objContact = objApp.ActiveInspector.currentItem 'wichtig: das ist das gerade geöffnete ContactItem!

'Benutzerfelder vom OL-Konatkt auf die Variablen zuordnen
ReDim strFields(0 To 4)

'Die Felder kann man dann einzeln ansprechen
With objContact
strFields(0) = .User2 ' KontakAdresse komplett
strFields(1) = .User3 ' Nur Anrede
strFields(2) = .User4 ' Nur Name
' Faxnummer festlegen, je nach Inhalt
If Trim(objContact.OtherFaxNumber) <> "" Then strFields(3) = objContact.OtherFaxNumber
If Trim(strFields(3)) = "" Then strFields(3) = objContact.BusinessFaxNumber
If Trim(strFields(3)) = "" Then strFields(3) = objContact.HomeFaxNumber
' Selected Mailadresse auslesen
If objContact.XXXX1 = 1 Then strFields(4) = objContact.Email1Address
If objContact.XXXX2 = 2 Then strFields(4) = objContact.Email2Address
If objContact.XXXX3 = 3 Then strFields(4) = objContact.Email3Address
End With

'Oder sie meinetwegen auch zusammenfassen:
For i = 0 To UBound(strFields)
strOutput = strFields(0)
strOutput1 = strFields(1)
strOutput2 = strFields(2)
strOutput3 = strFields(3)
strOutput4 = strFields(4)

' Aktiven Kontakt schließen
objContact.Close olPromptForSave 'und ggf. zum Speichern nachfragen
objApp.ActiveWindow.WindowState = olMinimized 'minimiert Outlook damit Word sichtbar wird

On Error Resume Next ' Fehlerroutine einschalten
Set objWordDoc = GetObject(, "Word.Application") 'Word Instanz suchen
Fehler = Err.Number
On Error GoTo 0 'Fehlerroutine wieder zurücksetzen
If Fehler = 429 Then
Set objWord = CreateObject("Word.Application") 'Word Instanz generieren
objWord.Visible = True 'Sichtbar machen
End If

Set objWord = GetObject(, "Word.Application") 'Word Instanz verbinden
objWord.Activate 'Wordinstanz sichtbar machen
objWord.Run MacroName:="Vorlagenshow" 'Vorlagenauswahl öffnen

'.WindowState = 1 'Fenster maximieren
On Error GoTo Ausgang 'Fehlerbehandlung falls Word beendet wird

' Dialog Vorlage öffnen und Vorlage auswählen lassen
'With objWord.Dialogs(wdDialogFileNew)
' .Display
' pfad = .Template
'End With

' Kontaktvariableninhalt der Textmarke zuordnen
Set objWordDoc = objWord.ActiveDocument

If objWordDoc.Bookmarks.Exists("tmUser2") Then
With objWordDoc
.Bookmarks("tmUser2").Range.Text = strOutput
End With
With objWordDoc
.Parent.Selection.Range.Text = strOutput
End With
End If
If objWordDoc.Bookmarks.Exists("tmUser3") Then
With objWordDoc
.Bookmarks("tmUser3").Range.Text = strOutput1
End With
End If
If objWordDoc.Bookmarks.Exists("tmUser4") Then
With objWordDoc
.Bookmarks("tmUser4").Range.Text = strOutput2
End With
End If
If objWordDoc.Bookmarks.Exists("tmUser5") Then
With objWordDoc
.Bookmarks("tmUser5").Range.Text = strOutput4
End With
End If
If objWordDoc.Bookmarks.Exists("tmFax") Then
With objWordDoc
.Bookmarks("tmFax").Range.Text = strOutput3
End With
End If
If objWordDoc.Bookmarks.Exists("tmSubject") Then
With objWordDoc
'.Bookmarks("tmSubject").Range.Text = "Angebot: " 'Betreffzeile einfügen
.Bookmarks("tmSubject").Range.Select 'zur Betreffzeile springen

End With
End If

' Objektvariablen freigeben
Set objWordDoc = Nothing
Set objWord = Nothing
Set objApp = Nothing
Set objNS = Nothing
Set objContact = Nothing
End Sub
Not open for further replies.
Thread starter Similar threads Forum Replies Date
S Display PF contact folder items to select contact to link to appointment Outlook VBA and Custom Forms 1
P Select image in contact notes field and save as jpg Outlook VBA and Custom Forms 6
N Select Existing BCM Business Contact in C# application Using Outlook 0
R Select contacts and print labels for selected contacts from complete contact list in Outlook. Using Outlook 1
L Rule to select incoming messages by contact category Using Outlook 11
N Not able to select the details of a head office synced contact Exchange Server Administration 4
R List folders in a combo box + select folder + move emails from inbox to that folder + reply to that email Outlook VBA and Custom Forms 1
R Add 'Company' to Select Names Form Using Outlook 1
B Select / activate first email item in the searched query Using Outlook 1
A Multi-select Listbox Outlook VBA and Custom Forms 6
H Select Specific Account When Sending Email, Based on Current Folder Outlook VBA and Custom Forms 1
N Auto-complete - block select emails Using Outlook 3
N Select Appointment subject line from combobox or list Outlook VBA and Custom Forms 1
G How to Copy Multi Select Listbox Data to Appointment Outlook VBA and Custom Forms 3
N Select a folder in a user account Outlook VBA and Custom Forms 2
Diane Poremsky Select from a List of Subjects before Sending a Message New Articles 0
Diane Poremsky Select Multiple Calendars in Outlook New Articles 0
oliv- How to select an mailitem in explorer with "show as conversation" Outlook VBA and Custom Forms 8
nathandavies Creating a Select Case for a directory of folders Outlook VBA and Custom Forms 1
B What is the best way to use Outlook address book to select customer and then open Excel Outlook VBA and Custom Forms 22
C Outlook 2007 Select Names Default columns Using Outlook 3
R Can BCM monitor and select specific emails and use content info to update the client's record? BCM (Business Contact Manager) 1
R Cannot select iCloud calendar Using Outlook 5
G Select Outlook account for BCM? BCM (Business Contact Manager) 2
Z Manual archive of select folders Using Outlook 1
R How to modify Outlook Select Rooms form columns Using Outlook 1
Z bulk add categories / with fixed colours / select multiple categories on a not Using Outlook 1
C Outlook editing won't select just one word Using Outlook 1
I Address book contacts not listed in "Select Names:Contacts" window Using Outlook 2
Y Outlook 2010 Select and reply to multiple messages at one time Using Outlook 0
Y Outlook 2010 Select and reply to multiple messages at one time Using Outlook 2
D Contacts as default in Select Names dialog Using Outlook 1
D How to select different account when sending emails from Outlook 2003 Using Outlook 3
E Outlook 2010 calendar print - select begin-end weeks for month print but Preview and print show ful Using Outlook 2
F Why do messages only arrive when I select the server's folder? Using Outlook 3
P Sharing Outlook contacts so users can select as an address book for email. Using Outlook 1
B Do not allow / Show to select "Tentative" option in Responce Using Outlook 1
H Exchange Server 2007 strips messages when clients select add item in a new Message Using Outlook 10
R Cannot select items from Outlook 2007 Menu bars Using Outlook 1
D Outlook 2010 crashes when I select new message, reply, forward or send as attachment Using Outlook 3
M Not able to select my contacts list for my address book Using Outlook 7
C Select folder to file send emails Using Outlook 1
G MS Exchange ActiveSync 2007 Denying Select Devices Exchange Server Administration 2
D Select categories to print Using Outlook 1
C Error when trying to select the Email Auto link option Using Outlook 2
Z "Select Names: Contacts" Menu displays contacts in different ways Using Outlook 6
G Select DAG for Express full backup ofr copy backups Exchange Server Administration 1
S Outlook 2003: For select messages only, would like replies automatically sent to 2 separate addresses. Using Outlook 4
B How do I select who the email is coming from and who replies go to for a mail merge? Using Outlook 1
J Select Remote Users Can't Connect to Exchange Server Exchange Server Administration 11
Similar threads