Outlook-Kontakt(e) in Excel überführen
17.06.2008 13:43:05
Tommi
ich habe aus dem Archiv einen Code für das Überführen von Outlook-Kontakten in eine Excel-Datei gefischt (unten aufgeführt). Leider produziert der Code bei mir bereits bei der Zeile "Dim outl As New Outlook.Application" eine Fehlermeldung (Benutzerdefinierter Typ nicht definiert). Auch bei den anderen im Archiv zu diesem Thema verfügbaren Codes kommt bei Zeilen mit "Outlook.Application" eine Fehlermeldung. Wisst Ihr vielleicht, was ich falsch mache?
Herzlichen Dank und schöne Grüße
Tommi
Sub KontakteVonOutlookNachExcel()
Dim KontaktOrdner As Object
Dim l As Long
Dim intMsgBox As Integer
Dim outl As New Outlook.Application
intMsgBox = MsgBox("Möchten Sie die Outlook-Adressen an der aktuellen Position einfügen?", _
_
vbQuestion + vbYesNo, "SmartTools Excel Weekly")
If intMsgBox = vbNo Then Exit Sub
Set olcontacts = outl.GetNamespace("MAPI"). _
GetDefaultFolder(olFolderContacts)
ActiveCell.Value = "Vorname"
ActiveCell.Offset(0, 1).Value = "Nachname"
ActiveCell.Offset(0, 2).Value = "Adresse"
ActiveCell.Offset(0, 3).Value = "Telefon"
ActiveCell.Offset(0, 4).Value = "Telefax"
ActiveCell.Offset(0, 5).Value = "E-Mail"
ActiveCell.Offset(0, 6).Value = "Geburtstag"
ActiveCell.Offset(1, 0).Select
For l = 1 To olcontacts.Items.Count
Set outobj = olcontacts.Items(l)
With outobj
ActiveCell.Value = .FirstName
ActiveCell.Offset(0, 1).Value = .LastName
ActiveCell.Offset(0, 2).Value = .BusinessAddress
ActiveCell.Offset(0, 3).Value = .BusinessTelephoneNumber
ActiveCell.Offset(0, 4).Value = .BusinessFaxNumber
ActiveCell.Offset(0, 5).Value = .Email1Address
ActiveCell.Offset(0, 6).Value = .Birthday
End With
ActiveCell.Offset(1, 0).Select
Next l
Set outobj = Nothing
Set olcontacts = Nothing
Set outl = Nothing
End Sub