Outlook VBA將電子郵件從子文件夾導入Excel

我試圖將我的收件箱中的每封電子郵件（發件人，收到時間，主題等）的詳細信息導入到Excel文件中。我的代碼對於收件箱中的特定文件夾工作正常，但我的收件箱有幾個子文件夾，並且這些子文件夾也有子文件夾。Outlook VBA將電子郵件從子文件夾導入Excel

經過多次試驗和錯誤，我設法導入收件箱下所有子文件夾的詳細信息。但是，代碼不會從第二層子文件夾中導入電子郵件，並且還會跳過仍在收件箱中的電子郵件。我已搜索此網站和其他人，但無法找到代碼來循環收件箱中的所有文件夾和子文件夾。

例如，我有一個包含子文件夾報告，定價和項目的收件箱。報告子文件夾具有稱爲每日，每週和每月的子文件夾。我可以在報告中導入電子郵件，但不能在每日，每週和每月導入。

，因爲它代表我的代碼如下：

Sub SubFolders() 

Dim olMail As Variant 
Dim aOutput() As Variant 
Dim lCnt As Long 
Dim xlSh As Excel.Worksheet 
Dim olApp As Outlook.Application 
Dim olNs As Folder 
Dim olParentFolder As Outlook.MAPIFolder 
Dim olFolderA As Outlook.MAPIFolder 
Dim olFolderB As Outlook.MAPIFolder 

Set olApp = New Outlook.Application 
Set olNs = olApp.GetNamespace("MAPI").GetDefaultFolder(olFolderInbox) 

Set olParentFolder = olNs 
ReDim aOutput(1 To 100000, 1 To 5) 

For Each olFolderA In olParentFolder.Folders 
    For Each olMail In olFolderA.Items 
    If TypeName(olMail) = "MailItem" Then 
    On Error Resume Next 
     lCnt = lCnt + 1 
     aOutput(lCnt, 1) = olMail.SenderEmailAddress 
     aOutput(lCnt, 2) = olMail.ReceivedTime 
     aOutput(lCnt, 3) = olMail.Subject 
     aOutput(lCnt, 4) = olMail.Sender 
     aOutput(lCnt, 5) = olMail.To 

    End If 
    Next 
Next 

Set xlApp = New Excel.Application 
Set xlSh = xlApp.Workbooks.Add.Sheets(1) 

xlSh.Range("A1").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput 
xlApp.Visible = True 

End Sub

來源

2015-11-04 Colin Torpey

見http://stackoverflow.com/questions/2272361/can-i-iterate-through-all-outlook-emails-in-a-folder-including-sub-folders – niton

謝謝。我使用鏈接中給出的代碼，並在Outlook中導入所有內容。雖然這很有用，但它提供的信息太多。我希望能夠指定一個文件夾（如收件箱）並從中導入所有內容以及它的子文件夾。你知道是否有可能修改上述代碼來實現這一目標？ –

從這個問題Can I iterate through all Outlook emails in a folder including sub-folders?

替換您嘗試遍歷文件夾...

For Each olFolderA In olParentFolder.Folders 
    For Each olMail In olFolderA.Items 
    If TypeName(olMail) = "MailItem" Then 
    On Error Resume Next 
     lCnt = lCnt + 1 
     aOutput(lCnt, 1) = olMail.SenderEmailAddress 
     aOutput(lCnt, 2) = olMail.ReceivedTime 
     aOutput(lCnt, 3) = olMail.Subject 
     aOutput(lCnt, 4) = olMail.Sender 
     aOutput(lCnt, 5) = olMail.To 
    End If 
    Next 
Next

...使用的想法在當前接受的答案中描述的遞歸。

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 ' <--- no brackets around oFolder 
     Next 
    End If 
End Sub

充實的第二個答案顯示瞭如何聲明代碼之外的變量來傳遞值。

Option Explicit 

Dim aOutput() As Variant 
Dim lCnt As Long 

Sub SubFolders() 
' 
' Code for Outlook versions 2007 and subsequent 
' Declare with Folder rather than MAPIfolder 
' 
Dim xlApp As Excel.Application 
Dim xlSh As Excel.Worksheet 

Dim olNs As Namespace 
Dim olParentFolder As Folder 

Set olNs = GetNamespace("MAPI") 
Set olParentFolder = olNs.GetDefaultFolder(olFolderInbox) 

lCnt = 0 
ReDim aOutput(1 To 100000, 1 To 5) 

ProcessFolder olParentFolder 

On Error Resume Next 
Set xlApp = GetObject(, "Excel.Application") 
On Error GoTo 0 
If xlApp Is Nothing Then Set xlApp = CreateObject("Excel.Application") 

Set xlSh = xlApp.Workbooks.Add.Sheets(1) 

xlSh.range("A1").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput 
xlApp.Visible = True 

ExitRoutine: 
    Set olNs = Nothing 
    Set olParentFolder = Nothing 
    Set xlApp = Nothing 
    Set xlSh = Nothing 

End Sub 

Private Sub ProcessFolder(ByVal oParent As Folder) 

Dim oFolder As Folder 
Dim oMail As Object 

For Each oMail In oParent.Items 

    If TypeName(oMail) = "MailItem" Then 
     lCnt = lCnt + 1 
     aOutput(lCnt, 1) = oMail.SenderEmailAddress 
     aOutput(lCnt, 2) = oMail.ReceivedTime 
     aOutput(lCnt, 3) = oMail.Subject 
     aOutput(lCnt, 4) = oMail.Sender 
     aOutput(lCnt, 5) = oMail.To 
    End If 

Next 

If (oParent.Folders.count > 0) Then 
    For Each oFolder In oParent.Folders 
     ProcessFolder oFolder 
    Next 
End If 

End Sub

來源

2015-11-05 20:14:59 niton

Outlook VBA將電子郵件從子文件夾導入Excel

回答

相關問題