Kann ich alle Outlook-E-Mails in einem Ordner mit Unterordnern durchlaufen?

Question

Ich habe einen Ordner, der eine Reihe von E-Mails und Unterordnern enthält. In diesen Unterordnern befinden sich mehr E-Mails.

Ich möchte einige VBA schreiben, die alle E-Mails in einem bestimmten Ordner durchlaufen werden, einschließlich der in einem der Unterordner. Die Idee ist, die SenderEmailAddress und SenderName aus jeder E-Mail zu extrahieren und etwas damit zu tun.

Ich habe versucht, nur den Ordner als CSV mit nur diesen beiden Feldern zu exportieren, und während dies funktioniert, unterstützt es nicht den Export von E-Mails in Unterordnern. Daher die Notwendigkeit, etwas VBA zu schreiben.

Bevor ich neu zu erfinden das Rad, jemand irgendwelche Code-Schnipsel oder Links zu Seiten hat, die, ein Ordnername angegeben, zeigt, wie für jede E-Mail in diesem Ordner und nachfolgenden Unterordnern ein MailItem Objekt erhalten ?

Answer 1

So etwas ...

Private Sub processFolder(ByVal oParent As Outlook.MAPIFolder) 

     Dim oFolder As Outlook.MAPIFolder 
     Dim oMail As Outlook.MailItem 

     For Each oMail In oParent.Items 

     'Get your data here ... 

     Next 

     If (oParent.Folders.Count > 0) Then 
      For Each oFolder In oParent.Folders 
       processFolder oFolder 
      Next 
     End If 
End Sub 

Answer 2

Dies hat eine Menge großartiger Code, der Sie interessiert sind. Gehen Sie in Outlook/VBA als Makro.

Const MACRO_NAME = "OST2XLS" 

Dim excApp As Object, _ 
    excWkb As Object, _ 
    excWks As Object, _ 
    intVersion As Integer, _ 
    intMessages As Integer, _ 
    lngRow As Long 

Sub ExportMessagesToExcel() 
    Dim strFilename As String, olkSto As Outlook.Store 
    strFilename = InputBox("Enter a filename (including path) to save the exported messages to.", MACRO_NAME) 
    If strFilename <> "" Then 
     intMessages = 0 
     intVersion = GetOutlookVersion() 
     Set excApp = CreateObject("Excel.Application") 
     Set excWkb = excApp.Workbooks.Add 
     For Each olkSto In Session.Stores 
      Set excWks = excWkb.Worksheets.Add() 
      excWks.Name = "Output1" 
      'Write Excel Column Headers 
      With excWks 
       .Cells(1, 1) = "Folder" 
       .Cells(1, 2) = "Sender" 
       .Cells(1, 3) = "Received" 
       .Cells(1, 4) = "Sent To" 
       .Cells(1, 5) = "Subject" 
      End With 
      lngRow = 2 
      ProcessFolder olkSto.GetRootFolder() 
     Next 
     excWkb.SaveAs strFilename 
    End If 
    Set excWks = Nothing 
    Set excWkb = Nothing 
    excApp.Quit 
    Set excApp = Nothing 
    MsgBox "Process complete. A total of " & intMessages & " messages were exported.", vbInformation + vbOKOnly, "Export messages to Excel" 
End Sub 

Sub ProcessFolder(olkFld As Outlook.MAPIFolder) 
    Dim olkMsg As Object, olkSub As Outlook.MAPIFolder 
    'Write messages to spreadsheet 
    For Each olkMsg In olkFld.Items 
     'Only export messages, not receipts or appointment requests, etc. 
     If olkMsg.Class = olMail Then 
      'Add a row for each field in the message you want to export 
      excWks.Cells(lngRow, 1) = olkFld.Name 
      excWks.Cells(lngRow, 2) = GetSMTPAddress(olkMsg, intVersion) 
      excWks.Cells(lngRow, 3) = olkMsg.ReceivedTime 
      excWks.Cells(lngRow, 4) = olkMsg.ReceivedByName 
      excWks.Cells(lngRow, 5) = olkMsg.Subject 
      lngRow = lngRow + 1 
      intMessages = intMessages + 1 
     End If 
    Next 
    Set olkMsg = Nothing 
    For Each olkSub In olkFld.Folders 
     ProcessFolder olkSub 
    Next 
    Set olkSub = Nothing 
End Sub 

Private Function GetSMTPAddress(Item As Outlook.MailItem, intOutlookVersion As Integer) As String 
    Dim olkSnd As Outlook.AddressEntry, olkEnt As Object 
    On Error Resume Next 
    Select Case intOutlookVersion 
     Case Is < 14 
      If Item.SenderEmailType = "EX" Then 
       GetSMTPAddress = SMTP2007(Item) 
      Else 
       GetSMTPAddress = Item.SenderEmailAddress 
      End If 
     Case Else 
      Set olkSnd = Item.Sender 
      If olkSnd.AddressEntryUserType = olExchangeUserAddressEntry Then 
       Set olkEnt = olkSnd.GetExchangeUser 
       GetSMTPAddress = olkEnt.PrimarySmtpAddress 
      Else 
       GetSMTPAddress = Item.SenderEmailAddress 
      End If 
    End Select 
    On Error GoTo 0 
    Set olkPrp = Nothing 
    Set olkSnd = Nothing 
    Set olkEnt = Nothing 
End Function 

Function GetOutlookVersion() As Integer 
    Dim arrVer As Variant 
    arrVer = Split(Outlook.Version, ".") 
    GetOutlookVersion = arrVer(0) 
End Function 

Function SMTP2007(olkMsg As Outlook.MailItem) As String 
    Dim olkPA As Outlook.PropertyAccessor 
    On Error Resume Next 
    Set olkPA = olkMsg.PropertyAccessor 
    SMTP2007 = olkPA.GetProperty("http://schemas.microsoft.com/mapi/proptag/0x5D01001E") 
    On Error GoTo 0 
    Set olkPA = Nothing 
End Function