Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
896to900
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
896to900
896to900
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Outlook Excel

Outlook Excel
19.08.2007 15:29:47
Venen0
Hallo Leute,
es gibt ja viele Posts zu dem Thema Synchronisation von Outlook Kontakten mit Excel. Habe da auch den richtigen Code zusammen"klau"ben können.
Frage: Wie kann ich Private Kontakte von der Übertragung nach Excel ausnehmen?
Danke und Grüße

Sub ContactsToExcel()
'Deklaration
Dim nspMapi As Outlook.NameSpace
Dim folMapi As Outlook.MAPIFolder
Dim itmAll As Outlook.Items
Dim itmReal As Outlook.Items
Dim itmContacts As Outlook.ContactItem
Dim strContactFilter As String
Dim excApp As Object
Dim excWkb As Object
Dim excWks As Object
Dim intRow As Integer
'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)
'Excel-Objekte öffnen
Set excApp = CreateObject("Excel.Application") 'Neue Excel-Instanz
Set excWkb = excApp.Workbooks.Add              'Neues Workbook anlegen
Set excWks = excWkb.Sheets(1)                  'Erstes Sheet
'Excel-Worksheet aufbereiten
With excWks
'Sheet-Name
.Name = "Outlook-Kontakte"
'Spaltenüberschriften
.Cells(1, 1).Value = "Vorname"
.Cells(1, 2).Value = "Nachname"
.Cells(1, 3).Value = "Firma"
.Cells(1, 4).Value = "Strasse"
.Cells(1, 5).Value = "PLZ"
.Cells(1, 6).Value = "Ort"
.Cells(1, 7).Value = "Land"
.Cells(1, 8).Value = "Telefon"
.Cells(1, 9).Value = "TelPrivat"
.Cells(1, 10).Value = "Fax"
.Cells(1, 11).Value = "Handy"
.Cells(1, 12).Value = "Email"
'Spaltenüberschriften fett
.Rows("1:1").Font.Bold = True
'Outlook-Kontakte nach Excel übertragen
intRow = 2
For Each itmContacts In itmReal
.Cells(intRow, 1).Value = itmContacts.FirstName
.Cells(intRow, 2).Value = itmContacts.LastName
.Cells(intRow, 3).Value = itmContacts.CompanyName
.Cells(intRow, 4).Value = itmContacts.BusinessAddressStreet
.Cells(intRow, 5).Value = itmContacts.BusinessAddressPostalCode
.Cells(intRow, 6).Value = itmContacts.BusinessAddressCity
.Cells(intRow, 7).Value = itmContacts.BusinessAddressCountry
.Cells(intRow, 8).Value = itmContacts.BusinessTelephoneNumber
.Cells(intRow, 9).Value = itmContacts.HomeTelephoneNumber
.Cells(intRow, 10).Value = itmContacts.BusinessFaxNumber
.Cells(intRow, 11).Value = itmContacts.MobileTelephoneNumber
.Cells(intRow, 12).Value = itmContacts.Email1Address
intRow = intRow + 1
Next itmContacts
'Optimale Spaltenbreite
.Columns.AutoFit
End With
'Excel einblenden
excApp.Visible = True
'Speicher freigeben
Set itmReal = Nothing
Set itmAll = Nothing
Set folMapi = Nothing
Set nspMapi = Nothing
Set excWks = Nothing
Set excWkb = Nothing
Set excApp = Nothing
End Sub


2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Outlook Excel
19.08.2007 17:58:00
sergiesam
hi,
du musst in der Schleife nur auf Privat abfragen - die Eigenschaft lautet Sensitivty
For Each itmContacts In itmReal
if itmcontacts.Sensitivity 2 then '2...olPrivate
...
end if
next itmContacts
Name Wert Beschreibung
olConfidential 3 Vertraulich
olNormal 0 Normale Vertraulichkeit
olPersonal 1 Persönlich
olPrivate 2 Privat
lg
sam

Anzeige
AW: Outlook Excel
20.08.2007 09:41:52
Stefan
Danke Dir. Das klappt schon mal ;)
Weisst du noch wie ich das Makro an einen Button im Outlook verknüpfen kann, um es von dor aus per Knopfdruck auszuführen?
Grüße

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige