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:

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 Sub

Noch ein frohes Osterwochenende...

Gruß

Alexander

Bitte markiere auch die Kommentare, die zur Lösung des Beitrags beigetragen haben

Content-ID: 113674

Url: https://administrator.de/contentid/113674

Ausgedruckt am: 22.11.2024 um 02:11 Uhr

1 Kommentar

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.

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 Sub