= "8" fuer Outlook
97/98, "9" fuer Outlook 2000 und "10" fuer Outlook 2002)
und klicken Sie auf OK, um die Aenderungen zu
uebernehmen.4. Fuegen Sie dem Projekt eine UserForm hinzu, auf der Sie
die folgenden Steuerelemente anlegen:
* Listenfeld "lstKontakte"
* Schaltflaeche "btnChoose", Caption= KONTAKTEORDNER...
* Schaltflaeche "btnInsert", Caption= EINFUEGEN
* Schaltflaeche "btnCancel", Caption= ABBRECHEN
5. Geben Sie im VBA-modul der UserForm das folgende Listing
ein:
Option Explicit
Dim objOutlook As Outlook.Application
Dim objNamespace As Outlook.NameSpace
Dim objFolder As Outlook.MAPIFolder
Dim objItems As Outlook.Items
Dim objContact As Outlook.ContactItem
Dim arrItemIDs() As String
Sub GetAdrList()
Dim Cnt As Long
Me.lstKontakte.Clear
Set objItems = objFolder.Items
objItems.Sort "[FileAs]"
For Each objContact In objFolder.Items
Me.lstKontakte.AddItem objContact.FileAs & _
" (" & objContact.BusinessAddressCity & ")"
ReDim Preserve arrItemIDs(Cnt + 1)
arrItemIDs(Cnt) = objContact.EntryID
Cnt = Cnt + 1
Next
End Sub
6. Legen Sie fuer die Ereignisse "Initialize" und
"Terminate" die folgenden Prozeduren fest:
Private Sub UserForm_Initialize()
On Error Resume Next
Application.StatusBar = _
"Moment bitte, Outlook-Kontakte werden gelesen..."
Set objOutlook = GetObject(, "Outlook.Application")
If Err <> 0 Or TypeName(objOutlook) = "Nothing" Then
On Error GoTo OutlErr
Err = 0
Set objOutlook = CreateObject("Outlook.Application")
End If
Erase arrItemIDs()
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objFolder = _
objNamespace.GetDefaultFolder(olFolderContacts)
GetAdrList
OutlEnde:
Application.StatusBar = ""
DoEvents
Exit Sub '!!!
OutlErr:
Beep
MsgBox "Zugriff auf Outlook ist nicht moeglich: " + _
Err.Description, vbOKOnly + vbCritical, _
"!!! Problem !!!"
Resume OutlEnde
End Sub
Private Sub UserForm_Terminate()
Set objFolder = Nothing
Set objNamespace = Nothing
Set objOutlook = Nothing
End Sub
7. Geben Sie fuer das Listenfeld "lstKontakte" die folgende
Ereignisprozedur ein:
Private Sub lstKontakte_DblClick(ByVal Cancel As
MSForms.ReturnBoolean)
btnInsert_Click
End Sub
8. Weisen Sie der Schaltflaeche "btnChoose" die folgende
Prozedur zu:
Private Sub btnChoose_Click()
Dim tmpFolder As Outlook.MAPIFolder
On Error Resume Next
Set tmpFolder = objNamespace.PickFolder
ActiveWindow.Activate
DoEvents
If Err <> 0 Or TypeName(tmpFolder) = "Nothing" Then
Beep
Exit Sub
End If
If objFolder.DefaultItemType <> olContactItem Then
MsgBox "Der Ordner "" + objFolder.Name + _
"" ist kein Kontakte-Odner!", _
vbOKOnly + vbCritical, "!!! Problem !!!"
Exit Sub
End If
Set objFolder = tmpFolder
GetAdrList
End Sub
9. Fuer die Schaltflaeche "btnInsert" geben Sie ein:
Private Sub btnInsert_Click()
Dim Idx As Long
Dim strAdr As String
Idx = Me.lstKontakte.ListIndex
If Idx < 0 Then
Beep
Exit Sub
End If
Set objContact = _
objNamespace.GetItemFromID(arrItemIDs(Idx))
strAdr = ""
With objContact
strAdr = strAdr & .Title & vbLf
strAdr = strAdr & .FirstName & " " & .LastName & vbLf
strAdr = strAdr & .BusinessAddressStreet & vbLf
strAdr = strAdr & .BusinessAddressPostalCode & _
" " & .BusinessAddressCity & vbLf
End With
Application.Selection = strAdr
Unload Me
End Sub
10. Das Abbrechen des Dialogfeldes ueber "btnCancel"
erreichen Sie ueber die folgende Prozedur:
Private Sub btnCancel_Click()
Unload Me
End Sub
11. Fuegen Sie nun dem Projekt noch ein allgemeines modul
hinzu und geben Sie hier das folgende Listing ein:
Sub OutlookAdresseWaehlen()
frmOutlAdr.Show
End Sub
12. Verlassen Sie die Entwicklungsumgebung und speichern Sie
die Arbeitsmappe.
Wenn Sie nun eine Adresse aus Outlook in Excel einfuegen
moechten, markieren Sie zunaechst die gewuenschte Zelle.
Druecken Sie dann Alt+F8, um die Makroauswahl aufzurufen und
klicken Sie zweimal auf den Eintrag "OutlookAdresseWaehlen".
Daraufhin erscheint die soeben angelegte UserForm, in dem
die zur Zeit im Kontakteordner vorhandenen Elemente in der
Form " (Ort)", also beispielsweise als
"Schmidt, Johannes (Muenchen)", auflistet sind. Mit einem
Doppelklick auf einen Eintrag (oder Markierung des Eintrages
und Klick auf EINFUEGEN) wird die dazugehoerige Adresse dann
in die aktuelle Zelle eingefuegt.
gruss andre