Question

我正在尝试使用以下代码来查看收件箱中Outlook中的所有文件夹和子文件夹以及来自电子邮件的源数据。

代码运行但它只能查看收件箱中的电子邮件和收件箱的FIRST子文件夹级别。但是，它不会查看第一个子文件夹中的所有后续子文件夹级别。

所以通过

了解它的内容

收件箱 - ＆gt;子文件夹1 - ＆gt;停止寻找

我希望它透过

收件箱 - ＆gt;子文件夹1 - ＆gt;子文件夹2 - ＆gt;子文件夹＆＃34; n＆＃34;

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

收件箱 - ＆gt;加拿大 - ＆gt;安大略省 - ＆gt;多伦多

OR

收件箱 - ＆gt;衣服 - ＆gt;便宜的衣服 - ＆gt;沃尔玛

它只通过收件箱和第一层，加拿大或衣服，但不查看加拿大/衣服下的文件夹，如安大略省或便宜的衣服。我希望它能够更进一步，看看多伦多和沃尔玛，这些都是安大略省和廉价服装下的文件夹。

Answer 1

有一个额外的循环，你正在混合父和文件夹。这是Excel代码，忽略了您的工作簿和工作表。

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中的每个文件夹和子文件夹

1 个答案: