Outlook die 2.

Informationen und Beispiele zu den hier genannten Dialog-Elementen:


Excel-Version: 9.0 (Office 2000)
nach unten

Betrifft: Outlook die 2.
von: Günther
Geschrieben am: 29.05.2002 - 16:26:43

Habe folgenden Code für den Export der Outlook-Kontakte verwendet:

Private Sub CommandButton7_Click()
Dim objOutlook As Object
Dim objAddressList As Object
Dim objAddressEntry As Object
Dim intCounter As Integer
Dim bln As Boolean
Application.ScreenUpdating = False
bln = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Set objOutlook = CreateObject("Outlook.Application")
Set objAddressList = _
objOutlook.Session.AddressLists("Contacts")
intCounter = 10
For Each objAddressEntry In objAddressList.AddressEntries
intCounter = intCounter + 1
If intCounter Mod 10 = 0 Then
Application.StatusBar = _
"Lese Adresse Nr. " & intCounter & " ein..."
End If
Cells(intCounter, 1) = objAddressEntry.Name

Set objAddressList = Nothing
Set objAddressEntry = Nothing
Set objOutlook = Nothing
Application.DisplayStatusBar = bln
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub

Ich würde gerne neben dem Namen noch die restlichen Daten aus den Kontakten importieren. Kennt jemand die entsprechenden Objektnamen im Outlook? (.Adresse, .Vorname, .Firma,.. funkt nicht!)

bitte helfen - danke
Günther

nach oben   nach unten

Re: Outlook die 2.
von: guenter
Geschrieben am: 29.05.2002 - 17:29:49

hm...versuchs mal mit diesen

Sub AdressenNachOutlook()
    Dim appOutLook As Outlook.Application
    Dim conoutlook As Outlook.ContactItem
    Set appOutLook = CreateObject("Outlook.Application")
    
    Range("A2").Select
    
    Do Until ActiveCell.Value = ""
    Set conoutlook = appOutLook.CreateItem(olContactItem)
    With conoutlook
        .FirstName = ActiveCell.Value
        .LastName = ActiveCell.Offset(0, 1).Value
        .BusinessAddress = ActiveCell.Offset(0, 2).Value & ", " & ActiveCell.Offset(0, 3).Value
        .BusinessAddressCountry = ActiveCell.Offset(0, 4).Value
        .BusinessAddressPostalCode = ActiveCell.Offset(0, 5).Value
        .BusinessAddressState = ActiveCell.Offset(0, 6).Value
        .Email1Address = ActiveCell.Offset(0, 7).Value
        .HomeTelephoneNumber = ActiveCell.Offset(0, 8).Value
        .BusinessTelephoneNumber = ActiveCell.Offset(0, 9).Value
        .BusinessFaxNumber = ActiveCell.Offset(0, 10).Value
        .Birthday = ActiveCell.Offset(0, 11).Value
        .Save
    End With
    ActiveCell.Offset(1, 0).Select
    Loop
    
    Set conoutlook = Nothing
    Set appOutLook = Nothing
    
End Sub


Sub AdressenVonOutlook()
Dim workingFolder As Object
Dim As Integer
Dim olMAPI As New Outlook.Application
    
   Range("A2").Select
   Set workingFolder = olMAPI.GetNamespace("MAPI").GetDefaultFolder(olFolderContacts)
   For i = 1 To workingFolder.Items.Count
    Set objItem = workingFolder.Items(i)
    With objItem
        ActiveCell.Value = .FirstName
        ActiveCell.Offset(0, 1).Value = .LastName
        ActiveCell.Offset(0, 2).Value = .BusinessAddress
        ActiveCell.Offset(0, 3).Value = .Email1Address
        ActiveCell.Offset(0, 4).Value = .HomeTelephoneNumber
        ActiveCell.Offset(0, 5).Value = .BusinessTelephoneNumber
        ActiveCell.Offset(0, 6).Value = .BusinessFaxNumber
        ActiveCell.Offset(0, 7).Value = .Birthday
     End With
     ActiveCell.Offset(1, 0).Select
   Next i
   
   Set objItem = Nothing
   Set olMAPI = Nothing
End Sub


 nach oben

Beiträge aus den Excel-Beispielen zum Thema "Outlook die 2."