VBA code to loop through every folder and subfolder in Outlook

Question

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.

The code runs but it ONLY l

Answer 1

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