1
Outlook 2007 Kontakt Import (per Makro)
Hallo zusammen,
ich sitze hier vor einem Problem und hoffe ihr Könnt mir helfen...
Ich möchte gerne über ein Makro Kontakte aus einer csv-Datei auslesen (nur bestimmte Felder) und in den Kontakte-Ordner importieren.
Das dies händisch (Import-Assistent) funktioniert weiß ich, aber wie es per Makro funktioniert weiß ich leider nicht.
Das Exportieren habe ich über folgendes, zusammengebasteltes Makro hinbekommen:
Noch ein frohes Osterwochenende...
Gruß
Alexander
ich sitze hier vor einem Problem und hoffe ihr Könnt mir helfen...
Ich möchte gerne über ein Makro Kontakte aus einer csv-Datei auslesen (nur bestimmte Felder) und in den Kontakte-Ordner importieren.
Das dies händisch (Import-Assistent) funktioniert weiß ich, aber wie es per Makro funktioniert weiß ich leider nicht.
Das Exportieren habe ich über folgendes, zusammengebasteltes Makro hinbekommen:
Public Sub ExportContacts()
Dim obj As ContactItem
' Statt c:\ besser ein anderes Vezeichnis für die Datei verwenden
Open "c:\Kontakte.csv" For Output As #1
' Titelzeile ausgeben
Print #1, "Vorname;Nachname;Firma;Straße;Ort;PLZ;Land;Fax;Telefon;Mobil;E-Mail Adresse"
For Each obj In Application.ActiveExplorer.Selection
' Für jedes Feld, welches wir exportieren wollen, eine neue Zeile, dies kann beliebig erweitert werden
Print #1, obj.FirstName; ";";
Print #1, obj.LastName; ";";
Print #1, obj.CompanyName; ";";
Print #1, obj.BusinessAddressStreet; ";";
Print #1, obj.BusinessAddressCity; ";";
Print #1, obj.BusinessAddressPostalCode; ";";
Print #1, obj.BusinessAddressState; ";";
Print #1, obj.BusinessFaxNumber; ";";
Print #1, obj.BusinessTelephoneNumber; ";";
Print #1, obj.MobileTelephoneNumber; ";";
Print #1, obj.Email1Address; ";";
Next
Close #1
End SubNoch ein frohes Osterwochenende...
Gruß
Alexander
Share on Facebook
Share on Twitter
Share on Reddit
Share on LinkedinPlease also mark the comments that contributed to the solution of the article
Content-Key: 113674
Url: https://administrator.de/contentid/113674
Printed on: April 24, 2024 at 18:04 o'clock
1 Comment
Hallo Alexander,
da ich aus deiner PN nun weiß, dass auch ein Import aus Excel in Frage kommt, hier nun mein Vorschlag:
Einfach Dateiname ändern und deinen Kontaktordner eintragen.
Wichtig ist auch, dass in der ersten Zeile der Excelliste immer der Feldname (LastName, FirstName, CompanyName) der Datensätze steht. Dies können auch benutzerdefinierte Feldnamen sein, hauptsache sie existieren.
Beachte aber bitte, dass hier immer direkt nach Dubletten gesucht wird (auch von dir gewünscht) und daher ein Einfügen je nach größe der Datenbank auch etwas länger dauern kann. Ich würde diese Art von Import nur bei kleinen Datenmengen verwenden und sonst eher nochmal ein Makro zur Dubletten-Suche schreiben.
Sub ist eigentlich mal für VB6 gewesen, sollte aber auch unter VBA laufen.
Mfg
Benny
da ich aus deiner PN nun weiß, dass auch ein Import aus Excel in Frage kommt, hier nun mein Vorschlag:
Einfach Dateiname ändern und deinen Kontaktordner eintragen.
Wichtig ist auch, dass in der ersten Zeile der Excelliste immer der Feldname (LastName, FirstName, CompanyName) der Datensätze steht. Dies können auch benutzerdefinierte Feldnamen sein, hauptsache sie existieren.
Beachte aber bitte, dass hier immer direkt nach Dubletten gesucht wird (auch von dir gewünscht) und daher ein Einfügen je nach größe der Datenbank auch etwas länger dauern kann. Ich würde diese Art von Import nur bei kleinen Datenmengen verwenden und sonst eher nochmal ein Makro zur Dubletten-Suche schreiben.
Sub ist eigentlich mal für VB6 gewesen, sollte aber auch unter VBA laufen.
Private Sub ImportContacts()
FileName = "c:\meienExcelliste.xls" 'HIER DEN DATEINAMEN
Dim Excel As Object
Set Excel = CreateObject("Excel.Application")
Excel.Visible = True
Excel.Workbooks.Open FileName
Dim x As Integer
Dim Y As Integer
x = Excel.worksheets.Item(1).usedrange.Columns.Count
Y = Excel.worksheets.Item(1).usedrange.Rows.Count
Dim i As Integer
Dim j As Integer
Dim aOutlook As Object
Dim Contacts As Object
Dim Contact As Object
Dim Filter As String
Dim DubContact As Object
Set aOutlook = Application
Set Contacts = aOutlook.GetNameSpace("MAPI").Folders.Item("Öffentliche Ordner").Folders("Alle öffentlichen Ordner").Folders("Kontakte von Test") 'DEN KONTAKTORDNER
For j = 2 To Y 'Jede Zeile in der Excelliste lesen
Set Contact = Contacts.Items.Add
For i = 1 To x 'Alle Eigenschaften in der Liste
Contact.itemProperties.Item(Excel.cells(1, i).Value).Value = Excel.cells(j, i).Value
Next i
Filter = "[LastName] = '" + Contact.LastName + "' AND [BusinessAddressPostalCode] = '" + Contact.BusinessAddressPostalCode + "' AND [BusinessAddressStreet] = '" + Contact.BusinessAddressStreet + "' AND [CompanyName]= '" + Contact.CompanyName + "'"
Set DubContact = Contacts.Items.Find(Filter)
If DubContact Is Nothing Then
Contact.Save
End If
Set Contact = Nothing
Next j
Exit Sub
ErrHandler:
If Err <> cdlCancel Then
MsgBox Err.Description
End If
Ende:
End SubMfg
Benny
