VBA代码循环遍历Outlook中的每个文件夹和子文件夹

问题描述

我正在尝试获取以下代码，以查看Outlook中收件箱"下的所有文件夹和子文件夹以及来自电子邮件的源数据.

I am trying to get the following code to look through all folders and subfolders in Outlook under Inbox and source data from the e-mails.

该代码可以运行，但只能通过收件箱"中的电子邮件和收件箱"的FIRST子文件夹级别进行查找.但是，它不会浏览第一个子文件夹中的所有后续子文件夹级别.

The code runs but it ONLY looks through e-mails in the Inbox and the FIRST subfolder level of the Inbox. However, it doesn't look through all the subsequent subfolder levels within the first subfolder.

这就是它的外观

收件箱->子文件夹1 ->停止查找

我希望它浏览

收件箱->子文件夹1->子文件夹2->子文件夹"n"

例如，我的收件箱中有以下文件夹:

So for example, I have the following folders in my Inbox:

1. 收件箱->加拿大->安大略省->多伦多

OR

1. 收件箱->衣服->廉价衣服->沃尔玛

它仅查看Inbox和第一级，即加拿大或衣服，但不查看加拿大/衣服下的文件夹，例如安大略省或便宜的衣服.我希望它进一步介绍一下多伦多和沃尔玛，它们是安大略省和便宜衣服下面的文件夹.

It only looks through Inbox and the first level, so Canada or clothes, but doesn't look into the folders under Canada/clothes, such as Ontario or Cheap Clothes. I want it to go further and look at Toronto and Walmart, which are folders under Ontario and Cheap clothes.

推荐答案

有一个额外的循环，您在混淆父级文件夹.这是有效的Excel代码，忽略了您的工作簿和工作表.

There is an extra loop and you are mixing up parent and folder. This is working Excel code, ignoring your workbook and worksheets.

Option Explicit

Sub repopulate3()

Dim olApp As Outlook.Application
Dim olNs As Outlook.Namespace
Dim olparentfolder As Outlook.Folder
Dim olMail As Object

Dim eFolder As Object
Dim i As Long
Dim wb As Workbook
Dim ws As Worksheet

Dim iCounter As Long
Dim lrow As Long
Dim lastrow As Long

'Set wb = ActiveWorkbook
'Set ws = wb.Worksheets("vlookup")

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

Set olNs = olApp.GetNamespace("MAPI")
Set olparentfolder = olNs.GetDefaultFolder(olFolderInbox)

'wb.Sheets("vlookup").range("A2:C500").ClearContents

'i think you want column E here, not L?
'lastrow = ThisWorkbook.Worksheets("vlookup").Cells(Rows.count, "E").End(xlUp).Row

ProcessFolder olparentfolder

ExitRoutine:

Set olparentfolder = Nothing
Set olNs = Nothing
Set olApp = Nothing

End Sub


Private Sub ProcessFolder(ByVal oParent As Outlook.Folder)

Dim olFolder As Outlook.Folder
Dim olMail As Object

Dim i As Long
Dim wb As Workbook
Dim ws As Worksheet
Dim iCounter As Long
Dim lrow As Long
Dim lastrow As Long

'Set wb = ActiveWorkbook
'Set ws = wb.Worksheets("vlookup")

'lastrow = ThisWorkbook.Worksheets("vlookup").Cells(Rows.count, "E").End(xlUp).Row

For i = oParent.Items.Count To 1 Step -1

    Debug.Print oParent
    If TypeOf oParent.Items(i) Is MailItem Then
        Set olMail = oParent.Items(i)

        Debug.Print " " & olMail.Subject
        Debug.Print " " & olMail.ReceivedTime
        Debug.Print " " & olMail.SenderEmailAddress
        Debug.Print

        'For iCounter = 2 To lastrow
            'If InStr(olMail.SenderEmailAddress, ws.Cells(iCounter, 5).Value) > 0 Then 'qualify the cell
                'With ws
                '   lrow = .range("A" & .Rows.count).End(xlUp).Row
                '   .range("C" & lrow + 1).Value = olMail.body
                '   .range("B" & lrow + 1).Value = olMail.ReceivedTime
                '   .range("A" & lrow + 1).Value = olMail.SenderEmailAddress
                'End With
            'End If
        'Next iCounter

    End If

Next i

If (oParent.Folders.Count > 0) Then
    For Each olFolder In oParent.Folders
        ProcessFolder olFolder
    Next
End If

End Sub

这篇关于VBA代码循环遍历Outlook中的每个文件夹和子文件夹的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！