E-Mail-Adresse aus Outlook-Kontakte
29.12.2007 08:54:03
Wolfgang
für den Versand einer Arbeitsmappe wird ein UF geöffnet. Ich würde gerne über eine Schaltfläche erreichen, dass ein weiteres UF geöffnet wird, in dem sämtliche Daten aus Kontakte in Outlook angezeigt werden. Es würde dabei aber ausreichen, den Namen und Vornamen sowie die E-Mail-Adresse anzuzeigen. Die jeweils markierte E-Mail-Adresse sollte dann in das ursprüngliche UF Textbox 1 eingefügt werden. Wie müßte ich den untenstehenden Code abändern? - Danke schon jetzt wieder für die Rückmeldungen.
Herzliche Grüße
Wolfgang
Sub Outlookkontakte()
Dim Verz As Object
Dim iIndx As Integer
Dim olMAPI As New Outlook.Application
Dim objItem As Object
Application.DisplayAlerts = False
Application.StatusBar = " die Adressen werden aus Outlook geholt " _
& " - das kann einen Moment dauern."
Set Verz = olMAPI.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
UserForm1.ListBox1.ColumnCount = 7
UserForm1.ListBox1.ColumnWidths = _
"7,0 cm; 3,5 cm; 1,0 cm; 3,0 cm; 1,0 cm; 3,5 cm; 3,0 cm"
For iIndx = 1 To Verz.Items.Count
Set objItem = Verz.Items(iIndx)
With objItem
UserForm1.ListBox1.AddItem " "
UserForm1.ListBox1.List(iIndx - 1, 0) = .FirstName _
& " " & .LastName
If .BusinessAddressPostOfficeBox = "" Then
UserForm1.ListBox1.List(iIndx - 1, 1) = .BusinessAddressStreet
Else
UserForm1.ListBox1.List(iIndx - 1, 1) = .BusinessAddressPostOfficeBox
End If
UserForm1.ListBox1.List(iIndx - 1, 2) = .BusinessAddressPostalCode
UserForm1.ListBox1.List(iIndx - 1, 3) = .BusinessAddressCity
UserForm1.ListBox1.List(iIndx - 1, 4) = .CustomerID
UserForm1.ListBox1.List(iIndx - 1, 5) = .AssistantName
UserForm1.ListBox1.List(iIndx - 1, 6) = .MiddleName
End With
Next iIndx
Set objItem = Nothing
Set olMAPI = Nothing
' die ListBox nach Namen (nach nur einer, der ersten Spalte) sortieren
'listbox_quick_sort 0, 6, UserForm1.ListBox1, 0, UserForm1.ListBox1.ListCount - 1
Application.DisplayAlerts = True
Application.StatusBar = False
End Sub
Private Sub CommandButton1_Click()
Outlookkontakte
End Sub