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

Status
Not open for further replies.

HDWTIGER

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?

Email1Address
Email2Address
Email3Address

Greetings from Germany...
Hans Dieter
 

Attachments

  • pic.jpg
    pic.jpg
    106.7 KB · Views: 313

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.

Code:
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
        Err.Clear
    Next
    Set objOL = Nothing
    Set objNS = Nothing
    Set obj = Nothing
    Set objContact = Nothing
    Set objItems = Nothing
    Set objContactsFolder = Nothing
End Sub
 

HDWTIGER

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)
Next

' 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
.Activate
End With
Else
With objWordDoc
.Parent.Selection.Range.Text = strOutput
.Activate
End With
End If
If objWordDoc.Bookmarks.Exists("tmUser3") Then
With objWordDoc
.Bookmarks("tmUser3").Range.Text = strOutput1
.Activate
End With
End If
If objWordDoc.Bookmarks.Exists("tmUser4") Then
With objWordDoc
.Bookmarks("tmUser4").Range.Text = strOutput2
.Activate
End With
End If
If objWordDoc.Bookmarks.Exists("tmUser5") Then
With objWordDoc
.Bookmarks("tmUser5").Range.Text = strOutput4
.Activate
End With
End If
If objWordDoc.Bookmarks.Exists("tmFax") Then
With objWordDoc
.Bookmarks("tmFax").Range.Text = strOutput3
.Activate
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
.Activate

End With
End If

Ausgang:
' Objektvariablen freigeben
Set objWordDoc = Nothing
Set objWord = Nothing
Set objApp = Nothing
Set objNS = Nothing
Set objContact = Nothing
End Sub
 
Status
Not open for further replies.
Similar threads
Thread starter Title 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
C must select message to trigger safe list Using Outlook 3
O VBA Cases with Listbox - Can you use Multi-Select? Outlook VBA and Custom Forms 4
E Asking user to select multiple options in a list in an email Outlook VBA and Custom Forms 0
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 Slipstick.com Articles 0
Diane Poremsky Select Multiple Calendars in Outlook New Slipstick.com 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
S Outlook 2007 caendar hangs when I select today's day BCM (Business Contact Manager) 4
J Select Names Dialog Box Outlook VBA and Custom Forms 16
S Outlook Email Help: Select custom voting button options VBA Outlook VBA and Custom Forms 1
W Outlook Coding - Select different email adresses to send from Outlook VBA and Custom Forms 5
A Select the position of an attached file in a HTML mailitem Outlook VBA and Custom Forms 1
H Select/Unselect items in ActiveExplorer by code? Outlook VBA and Custom Forms 2
M How to programmatically select a outlook search folder? Outlook VBA and Custom Forms 1
M Select Alternate profile Outlook VBA and Custom Forms 1
S Event for email message select Outlook VBA and Custom Forms 1
L RE: Select Users in Shared Database BCM (Business Contact Manager) 1
R select folder as addressbook Outlook VBA and Custom Forms 1
S Select a folder in Outlook (in code) Outlook VBA and Custom Forms 2
N contact list seen in Contact folder but knot in Address book or when 'TO' button is clicked in new email Using Outlook 0
M Disable Contact Card Results when using "Search People" in Outlook Ribbon Using Outlook 7
M Contact suggestion Using Outlook 2
H Custom Outlook Contact Form VBA Outlook VBA and Custom Forms 1
witzker HowTo Change message Class of contact form Outlook VBA and Custom Forms 0
witzker Open Contact missing in Outlook 2019 Using Outlook 2

Similar threads

Top