try this

Option Explicit


Sub ExportToExcel()
On Error GoTo 0
Dim nms As Outlook.NameSpace
Dim fld As Outlook.Folder
Dim Mainfld As Outlook.Folder
'Select export folder
Set nms = Application.GetNamespace("MAPI")
For Each Mainfld In nms.Folders(1).Folders
    If Mainfld Is Nothing Then GoTo 1:
    GetEmails Mainfld
    If Mainfld.Folders.Count > 0 Then
        For Each fld In Mainfld.Folders
            GetEmails fld
        Next fld
    End If
1:
Next Mainfld
End Sub
Sub GetEmails(fld As Outlook.Folder)
Dim appExcel As Excel.Application
Dim wkb As Excel.Workbook
Dim wks As Excel.Worksheet
Dim rng As Excel.Range
Dim strSheet As String
Dim strPath As String
Dim intRowCounter As Integer
Dim intColumnCounter As Integer
Dim msg As Outlook.MailItem
Dim itm As Object

strSheet = "OutlookItems.xls"
strPath = "E:\Examples\"
'strSheet = strPath & strSheet
Debug.Print strPath & strSheet
Debug.Print fld.FolderPath
'Handle potential errors with Select Folder dialog box.
If fld Is Nothing Then
    MsgBox "There are no mail messages to export", vbOKOnly, _
    "Error"
    Exit Sub
ElseIf fld.DefaultItemType <> olMailItem Then
    MsgBox "There are no mail messages to export in " & fld.FolderPath, vbOKOnly, _
    "Error"
    Exit Sub
ElseIf fld.Items.Count = 0 Then

    MsgBox "There are no mail messages to export in " & fld.FolderPath, vbOKOnly, _
    "Error"
    Exit Sub
End If

'Open and activate Excel workbook.
On Error Resume Next
Set appExcel = GetObject(, "excel.application")
On Error GoTo 0
If appExcel Is Nothing Then
    Set appExcel = CreateObject("Excel.Application")
End If
On Error Resume Next
Set wkb = appExcel.Workbooks(strSheet)
If wkb Is Nothing Then
    appExcel.Workbooks.Open (strPath & strSheet)
End If
On Error GoTo 0
Set wkb = appExcel.ActiveWorkbook
Set wks = wkb.Sheets(1)
wks.Activate
appExcel.Application.Visible = True


'Copy field items in mail folder.
For Each itm In fld.Items
    On Error Resume Next
    intColumnCounter = 1
    Set msg = itm
    intRowCounter = wks.Range("E" & wks.Rows.Count).End(xlUp).Row + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.To
    intColumnCounter = intColumnCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.SenderEmailAddress
    intColumnCounter = intColumnCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.Subject
    intColumnCounter = intColumnCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.SentOn
    intColumnCounter = intColumnCounter + 1
    Set rng = wks.Cells(intRowCounter, intColumnCounter)
    rng.Value = msg.ReceivedTime
    On Error GoTo 0
Next itm
End Sub