Code:
Option Explicit

Sub ExportToExcelV2()


    Dim appExcel As Excel.Application
    Dim appOutlook As Outlook.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 nms As Outlook.Namespace
    Dim FolderSelected As Outlook.MAPIFolder
    Dim varSender As String
    Dim itm As Object
    Dim lngColIndex As Long
    
    On Error GoTo ErrHandler
    Set appExcel = Application 'CreateObject("Excel.Application")
    Set appOutlook = GetObject(, "Outlook.Application")
    appExcel.Application.Visible = True
    Set wkb = ThisWorkbook
    Set wks = wkb.Sheets("exported data")
    appExcel.GoTo wks.Cells(1)
    Set nms = appOutlook.GetNamespace("MAPI")
    Do
        Stop
        Set FolderSelected = nms.PickFolder
         'Handle potential errors with Select Folder dialog box.
        If FolderSelected Is Nothing Then
            MsgBox "There are no mail messages to export", vbOKOnly, "Error"
            GoTo JumpExit
        ElseIf FolderSelected.DefaultItemType <> olMailItem Then
            MsgBox "These are not Mail Items", vbOKOnly, "Error"
            GoTo JumpExit
        ElseIf FolderSelected.Items.Count = 0 Then
            MsgBox "There are no mail messages to export", vbOKOnly, "Error"
            GoTo JumpExit
        End If
         'Copy field items in mail folder.
        intRowCounter = 1
        lngColIndex = 1
        wks.Cells(intRowCounter, lngColIndex).Resize(, 9).Value = Array("To", "From", "Subject", "Body", "Received", "Folder", "Category", "Flag Status", "Client")
        intRowCounter = wks.Cells(wks.Rows.Count, 1).End(xlUp).Row
        For Each itm In FolderSelected.Items
            intColumnCounter = 1
            If TypeOf itm Is MailItem Then
                Set msg = itm
                intRowCounter = intRowCounter + 1: Set rng = wks.Cells(intRowCounter, intColumnCounter): rng.Value = msg.To
                 '============================================================
                varSender = ResolveDisplayNameToSMTP(msg.SenderEmailAddress, appOutlook)
                If varSender = vbNullString Then varSender = msg.SenderEmailAddress
                 '============================================================
                 wks.Cells(intRowCounter, 2).Resize(, 8).Value = Array(varSender, RemoveREFW(msg.Subject), Left(msg.Body, 50), msg.ReceivedTime, FolderSelected.Name, msg.Categories, msg.FlagStatus, "=ISNA(MATCH(RC[-7],NonClient,0))")
                 varSender = vbNullString
            End If 'TypeOf
        Next itm
    Loop
JumpExit:
    Set appExcel = Nothing
    Set wkb = Nothing
    Set wks = Nothing
    Set rng = Nothing
    Set msg = Nothing
    Set nms = Nothing
    Set FolderSelected = Nothing
    Set itm = Nothing
    Exit Sub
ErrHandler:
    If Err.Number = 1004 Then
        MsgBox strSheet & " doesn't exist", vbOKOnly, "Error"
    Else
        MsgBox Err.Number & "; Description: " & Err.Description & vbCrLf & msg.ReceivedTime & vbCrLf & msg.Subject, vbOKOnly, "Error"
    End If
    Err.Clear: On Error GoTo 0: On Error GoTo -1
    GoTo JumpExit
    
End Sub


Function ResolveDisplayNameToSMTP(sFromName, objApp As Object)
     
    Dim oRecip As Recipient
    Dim oEU As ExchangeUser
    Dim oEDL As ExchangeDistributionList
     
    Set oRecip = objApp.Session.CreateRecipient(sFromName)
    oRecip.Resolve
    If oRecip.Resolved Then
        Select Case oRecip.AddressEntry.AddressEntryUserType
        Case OlAddressEntryUserType.olExchangeUserAddressEntry, OlAddressEntryUserType.olOutlookContactAddressEntry
            Set oEU = oRecip.AddressEntry.GetExchangeUser
            If Not (oEU Is Nothing) Then
                ResolveDisplayNameToSMTP = oEU.PrimarySmtpAddress
            End If
        Case OlAddressEntryUserType.olExchangeDistributionListAddressEntry
            Set oEDL = oRecip.AddressEntry.GetExchangeDistributionList
            If Not (oEDL Is Nothing) Then
                ResolveDisplayNameToSMTP = oEDL.PrimarySmtpAddress
            End If
        End Select
    End If
     
End Function


Private Function RemoveREFW(str As String) As String


    If Left$(UCase(str), 3) = "RE:" Or Left$(UCase(str), 3) = "FW:" Then
        str = Trim$(Mid$(str, 4))
    ElseIf Left(UCase(str), 4) = "FWD:" Then
        str = Trim$(Mid$(str, 5))
    End If
    RemoveREFW = Trim$(Replace$(Replace$(Replace$(str, "RE:", "", , , vbTextCompare), "FW:", "", , , vbTextCompare), "FWD:", "", , , vbTextCompare))
    
End Function


Sub CreatePiv()
    
    Dim pvc As PivotCache
    Dim pvt As PivotTable
    
    With ThisWorkbook
        Application.DisplayAlerts = 0
        On Error Resume Next
        .Worksheets("Output").Delete
        Err.Clear: On Error GoTo 0: On Error GoTo -1
        Application.DisplayAlerts = 1
        .Worksheets.Add(After:=.Sheets(.Sheets.Count)).Name = "Output"
        Set pvc = .PivotCaches.Create(SourceType:=xlDatabase, SourceData:=.Worksheets("Exported Data").Cells(1).CurrentRegion.Address(, , xlR1C1, True), Version:=xlPivotTableVersion12)
        Set pvt = pvc.CreatePivotTable(TableDestination:="Output!R3C1", TableName:="PvtCustom", DefaultVersion:=xlPivotTableVersion12)
    End With
    With pvt.PivotFields("Subject")
        .Orientation = xlRowField
        .Position = 1
        .Subtotals(1) = False
    End With
    With pvt.PivotFields("Received")
        .Orientation = xlRowField
        .Position = 2
        .Subtotals(1) = False
    End With
    With pvt.PivotFields("From")
        .Orientation = xlRowField
        .Position = 3
        .Subtotals(1) = False
    End With
    With pvt.PivotFields("Client")
        .Orientation = xlRowField
        .Position = 4
        .Subtotals(1) = False
    End With
    With pvt.PivotFields("Flag Status")
        .Orientation = xlRowField
        .Position = 5
        .Subtotals(1) = False
    End With
    With pvt
        .InGridDropZones = True
        .RowAxisLayout xlTabularRow
        .ColumnGrand = False
        .RowGrand = False
    End With
    
End Sub
The task completed date is always showing 1/1/4501

When does this show something else?