vba outlook to excel

Option Explicit
Sub email()
    Dim Path As String
    Dim FileName As String
    Dim xlApp As Excel.Application
    Dim ExcelWkBk As Excel.Workbook
    Dim ReceivedTime As Date
    Dim Sender As String
    Dim Subject As String
    Dim i As Integer
    Dim FolderTgt As MAPIFolder
    Dim Mail As MailItem
    Dim Lastrow As Integer
   
'******************change to the full path***************************************************************************************
    Path = "\\DrivePath\FolderName\****\"
    FileName = "Email.xls"
    Set xlApp = Application.CreateObject("excel.application")
    With xlApp
        .Visible = True
        Set ExcelWkBk = xlApp.Workbooks.Add
        With ExcelWkBk
            Worksheets("sheet1").Cells(1, 1) = "Received Time"
            Worksheets("sheet1").Cells(1, 2) = "Sender"
            Worksheets("sheet1").Cells(1, 3) = "Subject"
        End With
        ExcelWkBk.SaveAs FileName:=Path & FileName
    End With
'*******************change folder name***************************************************************************************************
    Set FolderTgt = CreateObject("outlook.application").GetNamespace("MAPI").GetDefaultFolder(olFolderInbox).Folders("FolderName")
    For i = FolderTgt.Items.Count To 1 Step -1
        If TypeOf FolderTgt.Items(i) Is MailItem Then
            Set Mail = FolderTgt.Items(i)
'*******************change criteria***************************************************************************************************
                If Mail.ReceivedTime = "1/22/2016" Then
               
                    Lastrow = ExcelWkBk.Worksheets("sheet1").Cells(ExcelWkBk.Worksheets("sheet1").Rows.Count, "A").End(xlUp).Row
                    ExcelWkBk.Worksheets("sheet1").Range("A" & Lastrow + 1) = Mail.ReceivedTime
                    ExcelWkBk.Worksheets("sheet1").Range("B" & Lastrow + 1) = Mail.SenderName
                    ExcelWkBk.Worksheets("sheet1").Range("C" & Lastrow + 1) = Mail.Subject
                End If
        End If
   
    Next i
   
ExcelWkBk.Save
Set xlApp = Nothing

   
   

End Sub