Excel-VBA-Code zum abrufen von e-mails aus outlook

Bin ich zu schreiben ein VBA-code, der ermittelt werden E-Mails aus Outlook, basierend auf bestimmten Bedingungen. Das problem, das ich habe ist, dass ich haben, um eine bestimmte Ordner in meinem code (im untenstehenden Beispiel wird der Ordner bezeichnet, ist "VOR Kunde". Ich möchte ermittelt werden alle E-Mails von meinem 'Posteingang' oder im besseren Fall aus allen outlook-Ordnern. Das problem ist, dass mein Posteingang besteht aus vielen Unterordnern (da rules0. Mein problem ist, dass ich kann nicht wissen, alle Unterordner-Namen (wie bei vielen Usern gehen, um das makro zu verwenden und noch jemand haben kann, der e-mails in Persönlichen Ordnern).
Könnten Sie bitte beraten, ist es ein Weg, um dieses problem zu überwinden?
Bitte lassen Sie mich wissen, wenn diese Frage ist ungenau (ich bin Neuling)

Bitte suchen Sie die Zeile, die ich habe probelm mit mit einem Kommentar markiert.

Sub GetFromInbox()

Dim olApp As Outlook.Application
Dim olNs As Namespace
Dim Fldr As MAPIFolder
Dim olMail As Variant
Dim i As Integer

Set olApp = New Outlook.Application
Set olNs = olApp.GetNamespace("MAPI")
'Below is the line I have problem with
Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("PRE Customer") 

i = 1
x = Date

For Each olMail In Fldr.Items
    If InStr(olMail.Subject, "transactions") > 0 _
    And InStr(olMail.ReceivedTime, x) > 0 Then  
        ActiveSheet.Cells(i, 1).Value = olMail.Subject
        ActiveSheet.Cells(i, 2).Value = olMail.ReceivedTime
        ActiveSheet.Cells(i, 3).Value = olMail.SenderName
        i = i + 1
    End If
Next olMail

Set Fldr = Nothing
Set olNs = Nothing
Set olApp = Nothing
End Sub
Weil der Outlook-security-system, ist es viel einfacher, zu schreiben, zu Excel aus Outlook als gelesen Outlook von Excel aus. Diese beiden Antworten von mir können geben Sie eine start. gewusst Wie: kopieren von Outlook-mail-Nachricht in excel mit VBA oder Makros gewusst Wie: importieren von outlook-E-mail Daten in Excel

InformationsquelleAutor Artur Rutkowski | 2014-05-19

  1. 11

    Einfach eine Schleife durch alle Ordner in Inbox.

    So etwas wie dies funktionieren würde.

    Edit1: Dies wird zur Vermeidung von leeren Zeilen.

    Sub test()
    Dim olApp As Outlook.Application, olNs As Outlook.Namespace
    Dim olFolder As Outlook.MAPIFolder, olMail As Outlook.MailItem
    Dim eFolder As Outlook.Folder '~~> additional declaration
    Dim i As Long
    Dim x As Date, ws As Worksheet '~~> declare WS variable instead
    Dim lrow As Long '~~> additional declaration

    Set ws = Activesheet '~~> or you can be more explicit using the next line
    'Set ws = Thisworkbook.Sheets("YourTargetSheet")
    Set olApp = New Outlook.Application
    Set olNs = olApp.GetNamespace("MAPI")
    x = Date

    For Each eFolder In olNs.GetDefaultFolder(olFolderInbox).Folders
        'Debug.Print eFolder.Name
        Set olFolder = olNs.GetDefaultFolder(olFolderInbox).Folders(eFolder.Name)
        For i = olFolder.Items.Count To 1 Step -1
            If TypeOf olFolder.Items(i) Is MailItem Then
                Set olMail = olFolder.Items(i)
                If InStr(olMail.Subject, "transactions") > 0 _
                And InStr(olMail.ReceivedTime, x) > 0 Then
                    With ws
                       lrow = .Range("A" & .Rows.Count).End(xlup).Row
                       .Range("A" & lrow).Offset(1,0).value = olMail.Subject
                       .Range("A" & lrow).Offset(1,1).Value = olMail.ReceivedTime
                       .Range("A" & lrow).Offset(1,2).Value = olMail.SenderName
                    End With
                End If
            End If
        Next i
        Set olFolder = Nothing
    Next eFolder
End Sub

    Oben und kümmert sich um alle Unterordner in Inbox.

    Ist es das, was du versuchst?

    Vielen Dank, jetzt muss ich versuchen, es zu überprüfen, nur e-mails von heute und erst dann mit anderen Bedingungen, wie Sie jetzt es gibt eine Menge von e-mails, so dass es langsam arbeitet.
    Hi, die Ausgänge mit den richtigen Daten, aber in dem Ort gibt es keine e-mails mit Bedingungen gibt es eine leere Stelle in Excel, die Ergebnisse, dass es leere Zeilen zwischen der abgerufenen e-mails.ABE Vielleicht haben Sie Idee wie kann ich dies beheben?
    Fix Leer Zeilen: Bewegen Sie den j = j + 1 bis 2 Linien.
    Siehe mein edit. Direkt auf die Letzte leere Zeile möglich ist der beste Weg.
    Ich weiß, ich bin ein bisschen spät zur party, aber gerade versucht, und es Stoppt bei 269 Zeilen, ich hab zwar keine Idee für das Leben von mir, warum. Irgendwelche Gedanken?

    InformationsquelleAutor L42

  2. 3

    Korrektur der Fehler (olFolderInbox ist ein Outlook nur konstant, so dass Sie brauchen, um zu definieren, es in vba nicht für Outlook):

    Const olFolderInbox = 6
'...
Set Fldr = olNs.GetDefaultFolder(olFolderInbox).Folders("PRE Customer")

    Auch um zu verhindern, dass fehlende Referenz bei der Ausführung von einem anderen computer aus, würde ich:

    Dim olApp As Object
Dim olNs As Object
Dim Fldr As Object
Dim olMail As Object
Dim i As Long
Set olApp = CreateObject("Outlook.Application")
'...

    Vielleicht wollen Sie auch zu deaktivieren ScreenUpdating, dann aktivieren Sie es in Excel, wenn Sie erwarten, eine lange Liste.

    UPDATE (Lösung für alle Ordner vom Root-Ordner)

    Benutzte ich etwas anderes für den Vergleich der Daten.

    Option Explicit

Private lRow As Long, x As Date, oWS As Worksheet

Sub GetFromInbox()
    Const olFolderInbox = 6
    Dim olApp As Object, olNs As Object
    Dim oRootFldr As Object ' Root folder to start
    Dim lCalcMode As Long

    Set olApp = CreateObject("Outlook.Application")
    Set olNs = olApp.GetNamespace("MAPI")
    Set oRootFldr = olNs.GetDefaultFolder(olFolderInbox).Folders("PRE Customer")
    Set oWS = ActiveSheet

    x = Date
    lRow = 1
    lCalcMode = Application.Calculation
    Application.Calculation = xlCalculationManual
    Application.ScreenUpdating = False
    GetFromFolder oRootFldr
    Application.ScreenUpdating = True
    Application.Calculation = lCalcMode

    Set oWS = Nothing
    Set oRootFldr = Nothing
    Set olNs = Nothing
    Set olApp = Nothing
End Sub

Private Sub GetFromFolder(oFldr As Object)
    Dim oItem As Object, oSubFldr As Object

    ' Process all mail items in this folder
    For Each oItem In oFldr.Items
        If TypeName(oItem) = "MailItem" Then
            With oItem
                If InStr(1, .Subject, "transactions", vbTextCompare) > 0 And DateDiff("d", .ReceivedTime, x) = 0 Then
                    oWS.Cells(lRow, 1).Value = .Subject
                    oWS.Cells(lRow, 2).Value = .ReceivedTime
                    oWS.Cells(lRow, 3).Value = .SenderName
                    lRow = lRow + 1
                End If
            End With
        End If
    Next

    ' Recurse all Subfolders
    For Each oSubFldr In oFldr.Folders
        GetFromFolder oSubFldr
    Next
End Sub
    Vielen Dank, ich werde versuchen, dies auch heute . Cheers
    Sie tun kann rekursiv in allen Ordnern im Posteingang, aber Sie müssen wissen, den Pfad des Ordners in Excel? Oder EntryID, wenn Sie verweisen möchten es später?
    Ich brauche nur die e-mails, die Eigenschaften (Betreff, Zeit aus), egal aus welchem outlook-Ordner, nur mit zusätzlichen Bedingungen wie "Wort" im Betreff und für heute (ich will, dies zu tun, überprüfen Sie das heutige Datum, um zu unmittelbaren dont, überprüfen Sie, ob das Datum nicht "heute")
    Versuchen Sie die aktualisierte code für rekursive Modus erhält eine root-Ordner.
    Dies kann einen Fehler erzeugen, wenn olMail innerhalb der olFldr ist nicht ein MailItem. +1, obwohl für LateBinding da dies von mehreren Benutzern verwendet werden, da die OP-Punkte aus. Beseitigen einen Unterschied in den Versionen.

    InformationsquelleAutor PatricK

Schreibe einen Kommentar