Excel/Adressen zu Outlook/Kontakte
28.05.2004 14:10:29
Gerhard
ich hab da einen Code gefunden, der leider nicht so ganz läuft, da ich aber etwas unerfahren mit Codes bin, versuche ich es nun hier.
Es soll von einer Excel-Tabelle, wo Adressen in verschiedenen spalten gespeichert sind dies zu Outlook in den Kontakte-Ordner transferieren, leider ist in der ersten Zeile schon Schluss, es kommt die Meldung"Fehler beim Kompilieren: Benutzerdefinierter Typ nicht definiert". Was bedeutet das? Liegt der Fehler meinerseits, oder ist der Code unsauber geschrieben worden?
Hier der Code:
Option Explicit
Sub AdressenKopieren()
Dim Appli As Outlook.Application
Dim Objekt As Outlook.ContactItem
Dim Termin As Outlook.AppointmentItem
Dim Zähler As Long
Set Appli = CreateObject("Outlook.Application")
Sheets("Kontakte").Activate
Range("A2").Select
For Zähler = 1 To ActiveSheet.UsedRange.Rows.Count - 1
Set Objekt = Appli.CreateItem(olContactItem)
Set Termin = Appli.CreateItem(olAppointmentItem)
With Objekt
.FirstName = ActiveCell.Value
.LastName = ActiveCell.Offset(0, 1).Value
.HomeAddress = ActiveCell.Offset(0, 2).Value _
& ", " & ActiveCell.Offset(0, 3).Value
.HomeAddressPostalCode = ActiveCell.Offset(0, 4).Value
.Email1Address = ActiveCell.Offset(0, 5).Value
.HomeTelephoneNumber = ActiveCell.Offset(0, 6).Value
.Save
End With
With Termin
.Subject = ActiveCell.Offset(0, 1).Value
.Start = ActiveCell.Offset(0, 7).Value & "2004" & " 08:00"
.ReminderMinutesBeforeStart = 10080
.ReminderSet = True
.ReminderPlaySound = True
.Save
End With
ActiveCell.Offset(1, 0).Select
Next Zähler
MsgBox "Es wurden " & Zähler - 1 & " Adressen kopiert."
Set Objekt = Nothing
Set Termin = Nothing
Set Appli = Nothing
End Sub
mfg
Gerhard S.