Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
860to864
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
860to864
860to864
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

860to864: liste als kontakte nach outlook

liste als kontakte nach outlook
06.04.2007 15:24:13
Marko
hallo
mit folgenem code füge ich meine adressen von einer exelliste in die outlook kontakte ein!
es werden immer nur die adressen eingefügt die neu dazu gekommen sind, da ist mir allerdings gerade ein sehr blödes problem aufgefallen.... er erstellt zwar keine neue kontaktkarte falls der name schon vorhanden ist aber im kalender schreibt er jedesmal wieder die geburtstage rein..... also hat man die anzeige des geburtstages dann doppelt und dreifach nach mehreren aktualisierungen!
kann mir einer sagen was da nun verkehrt läuft?
oder hat jemand einen anderen code zur übertragung nach outlook?

Sub Send_Contact_List()
Dim qWks As Worksheet, i As Integer
Dim MyOutApp As Object, MyOutCon As Object
Set qWks = Worksheets("Adressen")
Sheets(1).Select
Set MyOutApp = CreateObject("Outlook.Application")
With qWks
For i = 5 To Range("A65536").End(xlUp).Row
Set MyOutCon = GetKontakt(MyOutApp, Cells(i, 2).Value, Cells(i, 1).Value)
With MyOutCon
.Email1Address = Cells(i, 15).Value
.HomeTelephoneNumber = Cells(i, 8).Value
.Birthday = Cells(i, 9).Value
.Categories = Cells(i, 4).Value
.HomeAddressStreet = Cells(i, 5).Value
.HomeAddressPostalCode = Cells(i, 6).Value
.HomeAddressCity = Cells(i, 7).Value
.Save
End With
Set MyOutCon = Nothing
Next i
End With
Set MyOutApp = Nothing
End Sub


Function GetKontakt(OlApp As Object, LastName As String, FirstName As String) As Object
Dim f As Object, item As Object
' öffnet den Standard-Kontaktordner, 10 = olFolderContacts
Set f = OlApp.GetNamespace("MAPI").GetDefaultFolder(10)
' durchsucht dort alle Kontakte
For Each item In f.Items
' Falls Vor- und Nachname übereinstimmen wird dieser Kontakt zurückgegeben
If UCase(item.LastName) = UCase(LastName) And UCase(item.FirstName) = UCase(FirstName)   _
_
Then
Set GetKontakt = item
Exit Function
End If
Next
' Kein passender Kontakt gefunden, einen neuen Kontakt erstellen
Set GetKontakt = OlApp.CreateItem(2)
' Und dann noch die Namen eintragen
GetKontakt.LastName = LastName
GetKontakt.FirstName = FirstName
End Function

gruß marko

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: liste als kontakte nach outlook
07.04.2007 08:39:00
Oberschlumpf
Hi Marko
Nur ne Überlegung:
Kann man nicht mit

If .Birthday  Cells(i, 9).Value Then
.Birthday = Cells(i, 9).Value
End If

prüfen, ob schon ein gleicher Geb-Eintrag vorhanden ist?
Ciao
Thorsten
AW: liste als kontakte nach outlook
07.04.2007 12:55:37
Marko
hallo torsten
muss ich morgen mal testen, da er momentan garkeinen eintrag machen will.... hab heut nur leider keine zeit zu prüfen woran das nun liegt
trotzdem schonmal besten dank das du dir das mal angeguckt hast
gruß marko
AW: liste als kontakte nach outlook
08.04.2007 14:15:00
Marko
hallo Torsten,
also das klappt prima, besten dank
leider hab ich schon ein neues problem gefunden.... sobalt ich in den kontaken schon eine verteilerliste erstellt habe überträgt er die namen auch nicht mehr, da ich eine fehlermeldung in der funktion bekomme, wegen vor und zuname.... die verteiler muss man also immer erst löschen und nachher wieder einfügen
gruß marko
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige