Outlook Kontakte nach Open Office Calc exportieren
habe - nämlich outlook „kontakte“, wenn du mir helfen könntest
die adressen auf die editketten zu bekommen, würde ich das
andere (farbe etc.) „per hand“ machen.
Hallo Oscarinae,
man kann zwar die OL-Kontakte mit OL als .pst-Datei exportieren aber da kam bei mir nur unleserliches Zeug raus beim Einlesen mit OO-Writer.
Führe in OL das nachfolgende erste Makro „Exportieren“ aus.
Dann hast du eine Textdatei mit deinen Kontakten, Tab-getrennt.
In welchem Ordner sie steht und wie sie heißt legst du hier fest:
Open „K:\kwadressbuch.txt“ For Output As #1
Ändere das bei dir ab.
Das Makro „Exportieren“ führst du aus mit Alt+F8… in OL.
Starte dann Open Office Calc mit einer neuen Mappe.
Extras—Makros—Makros verwalten—OOo Basic…
Dort klickst du links doppelt auf den Mappennamen bis "Standard untendrunter erscheint, dann rechts auf „Neu“.
Dir wird „Modul1“ o.ä. vorgeschlagen, das übernimmst du.
Dann kopierst du dort den zweiten Code rein, änderst da auch den Pfad und Dateinamen ab. Editor schließen.
Zum Starten des OO-Calc-Makros „Importieren“ gehe in OO-Calc auf
Extras—Makros—Makros ausführen, klickst dich links wieder durch den Verzeichnisbaum und wählst dann rechts „Importieren“
Gruß
Reinhard
In OL Alt+F11, Einfügen—Modul, Code reinkopieren, ggfs. abändern, Editor schließen.
Option Explicit
Sub Exportieren()
'Deklaration
Dim nspMapi As Outlook.NameSpace, folMapi As Outlook.MAPIFolder, itmAll As Outlook.Items
Dim itmReal As Outlook.Items, itmContacts As Outlook.ContactItem, lngRow As Long
Dim strContactFilter As String, Satz As String
'Outlook-Objekte öffnen
Set nspMapi = Application.GetNamespace("MAPI")
Set folMapi = nspMapi.GetDefaultFolder(olFolderContacts)
Set itmAll = folMapi.Items
'Verteilerlisten herausfiltern, nur 'Richtige Kontakte' verwenden
strContactFilter = "[MessageClass] = 'IPM.Contact'"
Set itmReal = itmAll.Restrict(strContactFilter)
Close
Open "K:\kwadressbuch.txt" For Output As #1
Satz = "Vorname" & Chr(9) & "Nachname" & Chr(9) & "Strasse" & Chr(9) & "PLZ"
Satz = Satz & Chr(9) & "Ort" & Chr(9) & "Land" & Chr(9) & "Telefon"
Print #1, Satz
For Each itmContacts In itmReal
Satz = itmContacts.FirstName & Chr(9) & itmContacts.LastName & Chr(9) & itmContacts.BusinessAddressStreet
Satz = Satz & Chr(9) & itmContacts.BusinessAddressPostalCode & Chr(9) & itmContacts.BusinessAddressCity
Satz = Satz & Chr(9) & itmContacts.BusinessAddressCountry & Chr(9) & itmContacts.BusinessTelephoneNumber
Print #1, Satz
Next itmContacts
Close #1
'Speicher freigeben
Set itmReal = Nothing
Set itmAll = Nothing
Set folMapi = Nothing
Set nspMapi = Nothing
End Sub
Makro für Open Office Calc:
Sub Importieren
close
open "k:\kwadressbuch.txt" for input as #1
with thiscomponent.sheets(0)
while not eof(1)
input #1,Satz
S=split(satz,chr(9))
for N = lbound(s) to ubound(s)
.getcellbyposition(n,zei).string=s(n)
'if asc(mid(satz,n,1))
Aber Reinhard hat dir ja schon eine Lösung gepostet, die dir hoffentlich weiterhilft.