127
Administrator Startseite
Heiß diskutierte Fragen

Kontaktimport Excel nach Outlook inkl. benutzerdefinierter Felder (VB6 Code)

Mitglied: Trax83
23.03.2009
12:11:17 Uhr
11899 Aufrufe
12 Antworten
ID: 112138
Noch nicht bewertet
Vb6-Code für den Import von Kontaktdaten aus einer Exceldatei nach Outlook inklusive benutzerdefinierter Felder
Hallo,

hab mir schon diverse Import und Export Tools für unsere Kontaktdatenbank gebastelt, da bei der in Outlook integrierten Lösung keine benutzerdefinierten Felder übernommen werden.
Dabei hab ich mir nun ein Addin für Outlook geschrieben, welches diese Aufgabe übernimmt.

Das Formular besteht aus einem Button, einem CommonDialog und einer Listbox.

Die erste Zeile in der Exceldatei enthält dabei die Feldnamen für die Outlookdatenbank (Diese müssen exakt passen).


Quelltext | Drucken
01.
Private Sub Command1_Click() 
02.
  On Error GoTo ErrHandler 
03.
Dim vFiles As Variant 
04.
Dim lFile As Long 
05.
 
06.
With CommonDialog1 
07.
    .FileName = ""  
08.
    .CancelError = True 
09.
    .DialogTitle = "Select File" 
10.
    .Filter = "Excel-Datei (*.xls)|*.xls;" 
11.
    .ShowOpen 
12.
    vFiles = Split(.FileName, Chr(0)) 
13.
    If UBound(vFiles) <> 0 Then 
14.
       MsgBox ("Nur eine Datei auswählen") 
15.
      Goto Ende  
16.
End If 
17.
End With 
18.
 
19.
Dim Excel As Object 
20.
Set Excel = CreateObject("Excel.Application") 
21.
Excel.Visible = True 
22.
Excel.Workbooks.Open CommonDialog1.FileName 
23.
 
24.
Dim x As Integer 
25.
Dim Y As Integer 
26.
x = Excel.worksheets.Item(1).usedrange.Columns.Count 
27.
Y = Excel.worksheets.Item(1).usedrange.Rows.Count 
28.
 
29.
Dim i As Integer 
30.
Dim j As Integer 
31.
 
32.
Dim aOutlook As Object 
33.
Dim Contacts As Object 
34.
Dim Contact As Object 
35.
Dim Filter As String 
36.
Dim DubContact As Object 
37.
'Set aOutlook = Application  
38.
set aOutlook = CreateObject("Outlook.Application") 
39.
Set Contacts = aOutlook.GetNameSpace("MAPI").Folders.Item("Öffentliche Ordner").Folders("Alle öffentlichen Ordner").Folders("Kontakte von Test") 
40.
For j = 2 To Y    'Jede Zeile in der Excelliste lesen 
41.
  List1.Clear 
42.
  List1.AddItem ("Index: " + CStr(j)) 
43.
  Set Contact = Contacts.Items.Add 
44.
  For i = 1 To x  'Alle Eigenschaften in der Liste 
45.
    Contact.itemProperties.Item(Excel.cells(1, i).Value).Value = Excel.cells(j, i).Value 
46.
    List1.AddItem ("Schreibe " + Excel.cells(1, i).Value) 
47.
  Next i 
48.
  Filter = "[LastName] = '" + Contact.LastName + "' AND [BusinessAddressPostalCode] = '" + Contact.BusinessAddressPostalCode + "' AND [BusinessAddressStreet] = '" + Contact.BusinessAddressStreet + "' AND [CompanyName]= '" + Contact.CompanyName + "'" 
49.
  Set DubContact = Contacts.Items.Find(Filter) 
50.
  If DubContact Is Nothing Then 
51.
    List1.AddItem ("Kontakt nicht doppelt") 
52.
    List1.AddItem ("Kontakt gespeichert") 
53.
    Contact.Save 
54.
  Else 
55.
    List1.AddItem ("***Kontakt doppelt***") 
56.
  End If 
57.
  Set Contact = Nothing 
58.
Next j 
59.
 
60.
Exit Sub 
61.
ErrHandler: 
62.
If Err <> cdlCancel Then 
63.
    MsgBox Err.Description 
64.
End If 
65.
Ende: 
66.
End Sub


Mfg
Benny

Diskussionsverlauf (12 Antworten)
Mitglied: Server-Nutzer
Server-Nutzer schreibt am 06.04.2009 um 10:31:31 Uhr
Hallo Benny,

danke für die Anleitung bzw. eher das Skript.

Ich werde sie die Tage austesten. Meine Frage dazu: Welche Outlook-Version bedient sie (2003/2007) bzw. ist das für beide?

Viele Grüße
Jörg

PS: Vielleicht hast Du nen konzeptionellen Tipp für mich, wie man aus Outlook 2003 Adressen herausbekommt (im Sinne von Drag&Drop von Outlook nach Excel, ggf. auch per Export), wo die Postanschrift (Häcken gesetzt "Ist die Postanschrift") nicht in _einem_ Feld exportiert wird. Im Prinzip müsste es wohl ein Skript (?) sein, das abprüft, welche der beiden Adressen (Geschäftlich/Privat) die Postanschrift ist und dann alle Felder von AdressePrivat ODER AdresseGeschäftlich exportiert (Straße, PLZ, Ort).
Mitglied: Trax83
Trax83 schreibt am 06.04.2009 um 11:38:50 Uhr
Hallo Jörg,

ich benutz es unter 2003. Da jedoch lediglich das Outlook und Excel Object verwendet worden ist, sehe ich eigentlich keinen Grund, warum es unter 2007 nicht laufen sollte (habs aber nie getestet).


Willst du alle Kontakte exportieren oder nur die, die in dem Ordner ausgewählt wurden? An deiner Stelle würde ich mir nen VBA-Script machen und dann einen neuen Button in Outlook integieren, welcher das Makro startet.

Als VBA-Code würde das gehen:

Quelltext | Drucken
01.
Public Sub Export() 
02.
Dim Excel 
03.
Set Excel = CreateObject("Excel.Application") 
04.
Excel.Visible = True 
05.
Excel.Workbooks.Add 
06.
 
07.
Dim Y 
08.
 
09.
Dim aOutlook 
10.
Dim Contacts 
11.
Dim Contact 
12.
Dim Counter 
13.
Set aOutlook = Application 
14.
Set Contacts = aOutlook.ActiveExplorer.Selection 
15.
counter = Contacts.Count 
16.
 
17.
for i =1 to Counter 
18.
  set Contact = Contacts.Item(i) 
19.
  Y = Excel.worksheets.Item(1).usedrange.Rows.Count 
20.
  Excel.cells(y,1).value=Contact.MaillingAddressStreet 
21.
  Excel.cells(y,2).value=Contact.MailingAddressPostalCode 
22.
  Excel.cells(y,3).value=Contact.MailingAddressCity 
23.
  set Contact = Nothing 
24.
next i 
25.
 
26.
set Contacts = Nothing 
27.
set aOutlook = Nothing 
28.
set Excel = Nothing 
29.
 
30.
End Sub

Mfg
Benny
Mitglied: Server-Nutzer
Server-Nutzer schreibt am 06.04.2009 um 13:42:47 Uhr
Hi Benny.

man, bist Du schnell!

Wir haben hier auch nur Outlook 2003, das ist auch völlig ok für uns.


Hinsichtlich meines Export-Problems:

Ich hab das natürlich gleich ausprobiert, allerdings hängts an Zeile 20: Fehlermeldung Laufzeitfehler 438. Objekt unterstützt diese Eigenschaft oder Methode nicht.

BREAK: war nen _l_ zuviel bei Mailling

Jau, geht! Die als Postanschrift markierte Adresse wird separiert nach Straße, PLZ, Ort in eine neue Excel-Tabelle ausgegeben. Klasse!

Allerdings nur genau eine Adresse (da, wo in Outlook der Cursor drin steht (aktiv ist in der Telefonlistenansicht).

Mehrere Zeilen markieren hat leider nicht geholfen. (vermute, dass die Selektion in Zeile 14 abgefragt wird?)

Kannst Du noch mal bitte gucken, was da das Problem ist?

Wo kann ich nachschauen, wie die Outlook-Felder für Anrede, Vorname, Name, Firma und Telex laueten? (nicht wundern. Im Feld Telex steht bei uns die Anzahl von zu liefernden Publikationen face-smile )

Herzlichen Dank
Jörg
Mitglied: Trax83
Trax83 schreibt am 06.04.2009 um 16:57:38 Uhr
Ja ja, waren ein paar Fehlerchen drin... face-smile (so gehts)

Quelltext | Drucken
01.
Public Sub Export() 
02.
Dim Excel 
03.
Set Excel = CreateObject("Excel.Application") 
04.
Excel.Visible = True 
05.
Excel.Workbooks.Add 
06.
 
07.
Dim Y 
08.
 
09.
Dim aOutlook 
10.
Dim Contacts 
11.
Dim Contact 
12.
Dim Counter 
13.
Set aOutlook = Application 
14.
Set Contacts = aOutlook.ActiveExplorer.Selection 
15.
counter = Contacts.Count 
16.
 
17.
for i =1 to Counter 
18.
  set Contact = Contacts.Item(i) 
19.
  Y = Excel.worksheets.Item(1).usedrange.Rows.Count + 1 
20.
  Excel.cells(y,1).value=Contact.MailingAddressStreet 
21.
  Excel.cells(y,2).value=Contact.MailingAddressPostalCode 
22.
  Excel.cells(y,3).value=Contact.MailingAddressCity 
23.
  set Contact = Nothing 
24.
next i 
25.
 
26.
set Contacts = Nothing 
27.
set aOutlook = Nothing 
28.
set Excel = Nothing 
29.
 
30.
End Sub

Zeile 19 und 20 korrigiert....


Feldernamen geh mal in Outlook "Extras->Makro->VB-Script-Editor" in VB-Editor dann "Ansicht->Objectkatalog" da findeste dann alle Methoden Eigenschaften etc. fürs "ContactItem"


Mfg
Benny

was du suchst ist:
Titel
Firstname
Lastname
CompanyName
BusinessFaxNumber
Mitglied: Server-Nutzer
Server-Nutzer schreibt am 08.04.2009 um 13:55:44 Uhr
Hallo Benny,

ich hab das Skript probiert. An sich läuft es, jedoch gibt es noch eine kleine ""Macke"".

Die Variable Y bleibt immer auf 2, sie zählt offensichtlich in Zeile 19 nicht hoch.

Die Folge ist, dass ich beim Starten des Skriptes sehe, wie in der Excel-Tabelle in Zeile 2 alle im Outlook markieten Namensdatensätze ""durchrauschen"" (sieht cool aus face-smile ) und am Ende nur der letzte Datensatz in Zeile steht.

Könntest Du da bitte mal schauen? Ich krieg das nicht hin, habs probiert.

Ich muss mich mal mit den enormen Möglichkeiten von VB6 beschäftigen, wenn ich mal Zeit hab. Ist schon Klasse!

Viele Grüße
Jörg
Mitglied: Trax83
Trax83 schreibt am 08.04.2009 um 15:42:49 Uhr
Sorry Jörg,

hab nicht groß die Zeit, da jetzt nach Fehlern zu suchen, aber machs dir leicht,
nimm einfach "i" für die Zeile in Excel, geht genauso gut.

Quelltext | Drucken
01.
Public Sub Export() 
02.
Dim Excel 
03.
Set Excel = CreateObject("Excel.Application") 
04.
Excel.Visible = True 
05.
Excel.Workbooks.Add 
06.
 
07.
Dim aOutlook 
08.
Dim Contacts 
09.
Dim Contact 
10.
Dim Counter 
11.
Set aOutlook = Application 
12.
Set Contacts = aOutlook.ActiveExplorer.Selection 
13.
counter = Contacts.Count 
14.
 
15.
for i =1 to Counter 
16.
  set Contact = Contacts.Item(i) 
17.
  Excel.cells(i,1).value=Contact.MailingAddressStreet 
18.
  Excel.cells(i,2).value=Contact.MailingAddressPostalCode 
19.
  Excel.cells(i,3).value=Contact.MailingAddressCity 
20.
  set Contact = Nothing 
21.
next i 
22.
 
23.
set Contacts = Nothing 
24.
set aOutlook = Nothing 
25.
set Excel = Nothing 
26.
 
27.
End Sub

Und wir haben so auch Speicher gespart... face-smile (kein Dim Y)

Mfg
Benny
Mitglied: Server-Nutzer
Server-Nutzer schreibt am 08.04.2009 um 17:07:29 Uhr
Hi Benny,

ich danke Dir für Deine Mühe, das Skript geht!

Es bleibt zwar reproduzierbar immer genau nach 232 Adressen mit ner Fehlermeldung (Laufzeitfehler -142852667 (ab404005) ) stecken, aber vielleicht krieg ich das selber raus (i dimensionieren?)

Danke Dir nochmals.

Wenn ich es hinbekommen habe, werde ich es mit Verweis auf Deine Vorarbeit posten, damit alle was davon haben.

Viele Grüße
Jörg
Mitglied: Trax83
Trax83 schreibt am 08.04.2009 um 18:46:43 Uhr
oh je, damit hatte ich auch oft zu kämpfen in anderen scripts.... habs mal probiert, bei mir ist nach ca. 400 Adressen schluss.... zu wenig arbeitsspeicher... soweit ich weiß ist das ein bekanntes problem mit outlook, er gibt den speicher nicht wieder frei "set contact = Nothing"

versuch mal:

Quelltext | Drucken
01.
Public Sub Export() 
02.
Dim Excel 
03.
Set Excel = CreateObject("Excel.Application") 
04.
Excel.Visible = True 
05.
Excel.Workbooks.Add 
06.
 
07.
Dim aOutlook 
08.
Dim Contacts 
09.
Dim Contact 
10.
Set aOutlook = Application 
11.
Set Contacts = aOutlook.ActiveExplorer.Selection 
12.
 
13.
i = 1 
14.
 
15.
for each Contact in Contacts 
16.
  Excel.cells(i,1).value=Contact.MailingAddressStreet 
17.
  Excel.cells(i,2).value=Contact.MailingAddressPostalCode 
18.
  Excel.cells(i,3).value=Contact.MailingAddressCity 
19.
  i = i +1 
20.
next contact 
21.
 
22.
set Contacts = Nothing 
23.
set aOutlook = Nothing 
24.
set Excel = Nothing 
25.
 
26.
End Sub

sonst fällt mir da im moment auch nix mehr zu ein...

Mfg
Benny
Mitglied: Server-Nutzer
Server-Nutzer schreibt am 09.04.2009 um 09:33:50 Uhr
Hi Benny,

danke für Deine Unermüdlichkeit face-smile

249 Adressen kriegt er jetzt raus statt 232, dann wieder Laufzeitfehler.

Tja, ist dann doch nix mit 2800 Postanschriften für Druckerei aus Outlook 2003 auslesen... face-sad(

Herzliche Grüße und vielen Dank für Deine Mühe.

Jörg
Mitglied: Trax83
Trax83 schreibt am 09.04.2009 um 11:45:25 Uhr
Doch das geht schon nimm halt VB und nicht VBA. Mach dir ein Formular. Ließ dir die Konakte ein und sortiere sie z.B. nach [fileas] dann kannst du bei einem abbruch an dem Index weitermachen.

bei uns sind es 192.000 Kontakte in dem öffentlichen Ordner, über VBA hatte ich auch immer wieder Probleme damit. Deswegen siehe meinen ersten Beitrag ganz oben, Outlook Addin und nicht VBA Makro gebastelt.

Oder exportier doch mal über die Outlook eigene Funktion, dann musste doch nur die ganzen Felder die du nicht brauchst einfach löschen (5min. arbeit). Also "Datei->Importieren/Exportieren" musst aber zuvor, wenn die Kontakte in einem öffentlichen Ordner liegen sollten, ein Kopie des Ordners in dein Postfach legen.

Mfg
Benny
Mitglied: CeMeNt
CeMeNt schreibt am 20.04.2009 um 11:32:49 Uhr
Moin Benny,

könntest Du wohl noch dazu schreiben, an welche Stelle im Outlook dieser Code geschrieben werden muss?
Dann hätte Dein Beitrag den Titel "Anleitung" auch wirklich verdient...!

Ich hab's einfach mal in "DieseOutlookSitzung" kopiert.
Konnte aber nach einem Outlook-Neustart keine Änderungen feststellen.


Gruß CeMeNt
Mitglied: Trax83
Trax83 schreibt am 20.04.2009 um 15:41:52 Uhr
Moin CeMeNt,

schon mal ein Addin für Outlook mit VBA geschrieben? -Nein, ich auch nicht. In der Überschrift steht auch noch was von VB6, damit könnte unter Umständen Visual Basic 6.0 gemeint sein. Auch der kleine Hinweis auf den Inhalt des Formulars (Listbox, Button, Dialog) sollte aufgefallen sein, oder hast du unter VBA in Outlook schon irgendwo ein Formular entdeckt?

Daraus schließen wir, dass "dieser" Code in Outlook nirgendwo hingeschrieben wird.

Ist aber schnell geändert für VBA und das einfache "DieseOutlookSitzung" einfügen. Den hab ich aber nicht getestet.

Quelltext | Drucken
01.
Private Sub Command1_Click() 
02.
  On Error GoTo ErrHandler 
03.
 
04.
Dim FileName As String 
05.
FileName = "c:\meinExceldaten.xls" 
06.
 
07.
Dim Excel As Object 
08.
Set Excel = CreateObject("Excel.Application") 
09.
Excel.Visible = True 
10.
Excel.Workbooks.Open FileName 
11.
 
12.
Dim x As Integer 
13.
Dim Y As Integer 
14.
x = Excel.worksheets.Item(1).usedrange.Columns.Count 
15.
Y = Excel.worksheets.Item(1).usedrange.Rows.Count 
16.
 
17.
Dim i As Integer 
18.
Dim j As Integer 
19.
 
20.
Dim aOutlook As Object 
21.
Dim Contacts As Object 
22.
Dim Contact As Object 
23.
Dim Filter As String 
24.
Dim DubContact As Object 
25.
Set aOutlook = Application  
26.
Set Contacts = aOutlook.GetNameSpace("MAPI").Folders.Item("Öffentliche Ordner").Folders("Alle öffentlichen Ordner").Folders("Kontakte von Test") 
27.
For j = 2 To Y    'Jede Zeile in der Excelliste lesen 
28.
  Set Contact = Contacts.Items.Add 
29.
  For i = 1 To x  'Alle Eigenschaften in der Liste 
30.
    Contact.itemProperties.Item(Excel.cells(1, i).Value).Value = Excel.cells(j, i).Value 
31.
  Next i 
32.
  Filter = "[LastName] = '" + Contact.LastName + "' AND [BusinessAddressPostalCode] = '" + Contact.BusinessAddressPostalCode + "' AND [BusinessAddressStreet] = '" + Contact.BusinessAddressStreet + "' AND [CompanyName]= '" + Contact.CompanyName + "'" 
33.
  Set DubContact = Contacts.Items.Find(Filter) 
34.
  If DubContact Is Nothing Then 
35.
    Contact.Save 
36.
  End If 
37.
  Set Contact = Nothing 
38.
Next j 
39.
 
40.
Exit Sub 
41.
ErrHandler: 
42.
If Err <> cdlCancel Then 
43.
    MsgBox Err.Description 
44.
End If 
45.
Ende: 
46.
End Sub

Ist im Prinzip fast gleich. Filename muss deine Exceldatei rein und Contacts muss dein Kontaktordner rein, fertig.


Mfg
Benny
mehr ...Ähnliche Beiträge
Top
Copyright © 2012 Administrator Technology. Alle Inhalte sind unter der Creative Commons BY-SA 3.0 License lizensiert. Release: 3.1 (20120522-00) Load: 0.4226