Outlook alle Konten durchsuchen

Dim objApp As Object ' Outlook.Application Dim objItem As Object ' Outlook.MailItem Dim objFolder As Object Dim item As Object Dim i As Long Dim x As String Set objApp = CreateObject("Outlook.Application") ' Set objFolder = objApp.GetNameSpace("MAPI").GetDefaultFolder(6) ' 6 = olFolderInbox Set objFolder = objApp.GetNameSpace("MAPI").GetDefaultfolder(5). ' 5 = olFolderSentMail i = 1 For Each item In objFolder.Items If TypeName(item) = "MailItem" Then i = i + 1 x = item.CreationTime x = x & ", " & item.Subject Debug.Print x End If Next

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub OutlookAccounts_auflisten() Set O = Outlook.Session Debug.Print String(40, "-") Debug.Print "Anzahl accounts: " & O.Accounts.Count For Each A In O.Accounts Debug.Print A.DisplayName, A.CurrentUser.Name Next Debug.Print String(40, "-") End Sub

Im Objekt Outlook.Session gibt es eine Auflistung "Folders" dessen jeweiligen "Path" in _ Verbindung mit dem Account zu sehen ist. Account = "ich@meinfirma.de" Forders(1).Path = "\\ich@meinfirma.de" unter jedem Folder gibt es "Folders", die diesmal Posteingang, Postausgang, usw darstellen.

Sub OutlookFolders_auflisten() Dim N As Namespace Dim A As Account Dim S As Store Dim F Dim SF Set N = GetNamespace("MAPI") Debug.Print String(40, "-") Debug.Print "Anzahl accounts: " & N.Accounts.Count For Each A In N.Accounts Debug.Print A.DisplayName, A.CurrentUser.Name Next For Each F In N.Folders For Each SF In F.Folders Debug.Print SF.Name, SF.FolderPath Next Next End Sub

Sub OutlookFolders_auflisten() Dim N As Namespace Set N = GetNamespace("MAPI") MailItem_lesen N.GetDefaultFolder(olFolderInbox) End Sub Private Sub MailItem_lesen(F As Outlook.Folder) Dim I As Outlook.MailItem Dim A As Outlook.Attachment Dim SF As Outlook.Folder For Each I In F.Items If I.MessageClass = "IPM.Note" Then If I.Attachments.Count Then Debug.Print I.Subject For Each A In I.Attachments Debug.Print A.Filename Next End If End If Next 'Achtung rekurivität! ' For Each SF In F.Folders ' MailItem_lesen SF ' Next End Sub

Hallo Yal
und nochmal herzlichen Dank, dass Du Dir mit meinem Problem solche Mühe gibst. Aber Du hast mir echt sehr weitergeholfen.
Mein Code sieht mittlerweile so aus:


Function OutlookDurchsuchen(ByVal PdfName As String, _
ByVal ReNr As String)
Dim N As Namespace
Dim A As Account
Dim S As Store
Dim F
Dim SF
Dim item
Dim v, x, y, z As String
Set N = GetNamespace("MAPI")
For Each F In N.Folders
For Each SF In F.Folders
I = 1
For Each item In SF.Items
On Error GoTo Fehler
If item.Attachments.Count > 0 Then
v = item.Attachments.item(1).FileName
If Len(v) > 30 Then
v = Mid(v, 1, Len(v) - 18)
'Debug.Print SF.FolderPath, SF.Name, item
If PdfName = v Then
I = I + 1
x = item.CreationTime
y = item.Subject
z = item.To
If MsgBox("Diese Rechnung mit der Rechnungsnummer:" & Chr(13) & _
ReNr & Chr(13) & "wurde bereits am:" & Chr(13) & x & Chr(13) & "an: " & Chr(13) & z & Chr(13) & "versendet." & _
Chr(13) & "Möchtest Du sie nochmal versenden?", vbYesNo, " _
Rechnung bereits versendet") = vbNo Then
End
Else
Exit Function
End If
End If
End If
End If
Next
Fehler:
Next
Next
End Function

Allerdings braucht es ca 2,5 Minuten, bis alle Ordner durchlaufen sind, bzw. bis er die entsprechende Rechnung findet.
Und - es funktioniert zwar bei mir, aber bei meinem Freund, für den es eigentlich gedacht ist, findet er die Rechnung nicht, obwohl es nur ein Account ist mit nur 7 Ordnern.
Und es dauert bei ihm trotzdem noch gefühlt ca 45 Sec.
Bei dem Code, den Du mir zuletzt geschickt hast, durchsucht er nur den Standardaccount. Oder?
Denkst Du man könnte meinen Code noch optimieren, sodass er schneller durchläuft?
VG
Oisse

Hallo Oisse,
Vielen Dank für die Rückmeldung.
"durchsucht er nur den Standardaccount. Oder?" --> ja.
Wie gesagt, alle Folders durchlaufen, Name extrahieren, daraus eine Liste der "übliche Verdächtigen" herstellen und nur auf diesen laufen lassen.
Sollte ein starkte Hierarchisierung (Konstellation RootVerz\SubVerz), nur den entsprechenden RootVerz auflisten und rekursiv durchgehen: siehe Coding von vorher, im auskommentierte Teil: die Sub MailItem_lesen ruf sich selbst mit je einen Subfolder.
"On Error Goto Fehler gehört nicht innerhalb der Sub sondern ganz am Anfang. Es gilt bis "On Error Goto 0" vorkommt oder bis Ende der Sub. Hier könnte/sollte man separate Sub bauen.
Springmarke innerhalb eines For-Schleife ist von unschön bis potentiell gefährlich.
VG
Yal

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

14 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Outlook alle Konten durchsuchen

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

14 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread