Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1540to1544
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
Inhaltsverzeichnis

Kontaktdaten auflisten

Kontaktdaten auflisten
22.02.2017 08:12:55
Thomas
Hallo Excelfreunde,
ich möchte gern alle Outlookkontakte mit den eingegangenen Mail ( nur die Absender Daten) vergleichen.
Um zu prüfen ob ich in Outlook alle Kontakte eingetragen habe.
Nun suche ich ein Ansatz um dies umzusetzen.
Mein Ansatz wäre ich importiere alle kontakte aus Outlook in Excel. Dies geht ja mit der eigenen CSV Export / Import Funktion.
Wenn ich nun die die Absenderadressen aus den Outlook ( Exchange )auslesen könnte würde ich Sie mit Excel eigenes Bordmaterial einfach vergleichen können.
Hat jemand ein Beispiel dafür parat? Oder gibt es da ein besseren Ansatz.
besten dank schon mal für eurer Interesse an meinem Problem
MFG Thomas

3
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
überspringt einfach nicht den Fehler
22.02.2017 09:13:34
thomas
Hallo Excelfreunde,
ich habe ein kleinen Ansatz gefunden.
Leider kommt bei irgendeiner Mail ein Fehler und das Macro stürzt ab. Ich bekomme aber einfach nicht raus welche es ist.
Und Leider greift das On Error Resume Next nicht weiß jemand wie ich gnadenlos jeden Fehler überspringen kann?
viele liebe grüsse thomas
Public Sub ReadMailItems()
Dim olapp        As Object
Dim olName       As Object
Dim olHFolder    As Object
Dim olUFolder    As Object
Dim strAttCount  As String
Dim olItemsCount As Long
Dim lngAttCount  As Long
Dim letzteZeile  As Long
On Error Resume Next
Set olapp = CreateObject("Outlook.Application")
Set olName = olapp.GetNamespace("MAPI")
Set olHFolder = olName.Session.Folders("t.simpig@vgbelzig.de") ' Kontoname
Set olUFolder = olHFolder.Folders("Posteingang") 'Ordnername
letzteZeile = Sheets("Tabelle4").Range("A" & Rows.Count).End(xlUp).Row
For olItemsCount = 1 To olUFolder.Items.Count
With olUFolder.Items.Item(olItemsCount)
For lngAttCount = 1 To .Attachments.Count
If strAttCount = "" Then
strAttCount = .Attachments.Item(lngAttCount).Filename
Else
strAttCount = strAttCount & vbCrLf & .Attachments.Item(lngAttCount). _
Filename
End If
Next lngAttCount
On Error Resume Next
Sheets("Tabelle1").Range("A" & olItemsCount + letzteZeile).Value = olHFolder. _
Name & "->" & olUFolder.Name
Sheets("Tabelle1").Range("B" & olItemsCount + letzteZeile).Value = .Sender
Sheets("Tabelle1").Range("C" & olItemsCount + letzteZeile).Value = . _
SenderEmailAddress
Sheets("Tabelle1").Range("D" & olItemsCount + letzteZeile).Value = . _
ReceivedTime
Sheets("Tabelle1").Range("E" & olItemsCount + letzteZeile).Value = .Subject
Sheets("Tabelle1").Range("F" & olItemsCount + letzteZeile).Value = strAttCount
strAttCount = ""
End With
Next olItemsCount
On Error GoTo 0
End Sub

Anzeige
AW: überspringt einfach nicht den Fehler
25.02.2017 15:34:21
Piet
Hallo Thomas,
warum versagt Resume Next? Gute Frage, auf die ich so auch keine Antwort weiss. Experimentiere dann solange mit dem Code, bis ich herausfinde ab welcher Stelle Excel versagt? Unten dein Code, von mir durch zwei neue Variable etwas verkürzt, mit zwei Testzeilen für den Programm Abbruch in Tabelle1. Einfach in Zelle H1+H2 beide Zaehler anzeigen lassen, damit du erkennst ab welcher Zeile der Abbruch erfolgt. Dazu noch eine Frage?
Kann in der Zeile die du einliest am Anfang ein "=" Zeichen stehen? Das ist fatal, Excel versteht darunter immer eine Formel!! Dann müsstest du unbedingt ein Semikolon ' davor setzen, und den Text dann so einlesen: = "' " & Text
Im Zweifelsfall den ganzen Text Bereich wo du nur Text einliesst auf Text formatieren. Könnte auch helfen.
Lasse den Thread offen, falls ein anderer Ratgeber eine bessere Lösung weiss.
mfg Piet
Public Sub ReadMailItems()
Dim olapp        As Object
Dim olName       As Object
Dim olHFolder    As Object
Dim olUFolder    As Object
Dim strAttCount  As String
Dim olItemsCount As Long
Dim lngAttCount  As Long
Dim letzteZeile  As Long
Dim spa          As Integer  'Spalten Nr
Dim FilTxt       As String   'File Text
On Error Resume Next
Set olapp = CreateObject("Outlook.Application")
Set olName = olapp.GetNamespace("MAPI")
Set olHFolder = olName.Session.Folders("t.simpig@vgbelzig.de") ' Kontoname
Set olUFolder = olHFolder.Folders("Posteingang") 'Ordnername
letzteZeile = Sheets("Tabelle4").Cells(Rows.Count, 1).End(xlUp).Row
For olItemsCount = 1 To olUFolder.Items.Count
With olUFolder.Items.Item(olItemsCount)
'** nur zum Test ab wo Resume Next versagt !!
Sheets("Tabelle1").Range("H1") = olItemsCount
For lngAttCount = 1 To .Attachments.Count
'** nur zum Test ab wo Resume Next versagt !!
Sheets("Tabelle1").Range("H2") = lngAttCount
FilTxt = .Attachments.Item(lngAttCount).Filename
If strAttCount = "" Then
strAttCount = FilTxt
Else
strAttCount = strAttCount & vbCrLf & FilTxt
End If
Next lngAttCount
On Error Resume Next
spa = olItemsCount + letzteZeile
Sheets("Tabelle1").Range("A" & spa).Value = olHFolder.Name & "->" & olUFolder. _
Name
Sheets("Tabelle1").Range("B" & spa).Value = .Sender
Sheets("Tabelle1").Range("C" & spa).Value = .SenderEmailAddress
Sheets("Tabelle1").Range("D" & spa).Value = .ReceivedTime
Sheets("Tabelle1").Range("E" & spa).Value = .Subject
Sheets("Tabelle1").Range("F" & spa).Value = strAttCount
strAttCount = ""
End With
Next olItemsCount
On Error GoTo 0
End Sub

Anzeige
AW: überspringt einfach nicht den Fehler
26.02.2017 21:55:31
onur
Hi,
Errorbehandlung greift nur, wenn im vbaeditor/optionen/allgemein steht:
Unterbrechen bei nicht verarbeiteten fehlern statt bei jedem Fehler.

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige