Hallo liebe Forenmitglieder,
ich setze mich seit Wochen mit dem Bezug von E-mails aus einer geteilten Outlook Inbox auseinander (mittels Makro/VBA).
Obwohl ich eigentlich keine Ahnung von der Materie habe, habe ich es geschafft, ein Makro zu generieren welche meine benötigten Informationen (Absender, E-Mail Titel, Datum)bezieht.
Mein Makro fragt alle E-Mails aus der Inbox (oder mit zusätzlicher Code-Zeile die Mails aus einem der Unterordner ab).
Leider bekomme ich es einfach nicht hin, zeitgleich Nachrichten aus Inbox UND einzelner spezifischer/aller Unterordner zu extrahieren. Also quasi All oder Inbox & Unterordner 1
Würde mir unglaublich weiterhelfen!
Nun ist unsere Inbox so strukturiert:
Überordner: Inbox
Unterordner 1: Deutschland
Unterordner 2: Österreich
Unterordner 3: Schweiz
Das Makro lautet:
Private Sub CommandButton1_Click()
Dim olApp As Outlook.Application
Dim olNS As Outlook.Namespace
Dim olFldr As Outlook.MAPIFolder
Dim olItem As Object
Dim olMailItem As Outlook.MailItem
Set ws = ThisWorkbook.Worksheets("Arbeitsblatt1")
Set olApp = New Outlook.Application
Set olNS = olApp.GetNamespace("MAPI")
Set olFldr = olNS.Folders("EngOffice")
Set olFldr = olFldr.Folders("Inbox")
Set olFldr = olFldr.Folders("Deutschland") ´ZUR ABFRAGE IN EINEM UNTERORDNER
ws.Cells.Range("A2:D300").ClearContents
iRow = 2
Application.ScreenUpdating = False
For Each olItem In olFldr.Items
If olItem.Class = olMail Then
Set olMailItem = olItem
With olMailItem
ws.Cells(iRow, "A") = .Sender
ws.Cells(iRow, "B") = .Subject
ws.Cells(iRow, "C") = .ReceivedTime
ws.Cells(iRow, "D") = olFldr.Name
iRow = iRow + 1
End With
End If
Next olItem
With ws
hdr = Array("Sender", "Subject", " Received Time ", " Folder ", "Platzhalter")
.Range("A1").Resize(, UBound(hdr)) = hdr
.Columns.AutoFit
End With
Application.ScreenUpdating = False
End Sub
|