Const olFolderInbox As Integer = 6
'~~> Path for the attachment
Const AttachmentPath As String = "e:\temp\"


Sub DORscan_1()
    Dim oOlAp As Object, oOlns As Object, oOlInb As Object
    Dim oOlItm As Object, oOlAtch As Object
    Dim wb As Workbook
    Dim i As Integer
    i = 1
    Dim value As Variant
    Dim value1 As Variant
    Dim value2 As Variant
    Dim value3 As Variant
    Dim value4 As Variant
    Dim value5 As Variant
    
    Dim v_date As String
        
    '~~> New File Name for the attachment
    Dim NewFileName As String
    NewFileName = AttachmentPath & "test1.xls"

    '~~> Get Outlook instance
    Set oOlAp = GetObject(, "Outlook.application")
    Set oOlns = oOlAp.GetNamespace("MAPI")
    Set oOlInb = oOlns.GetDefaultFolder(olFolderInbox)

    '~~> Check if there are any actual unread emails
    If oOlInb.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "NO Unread Email In Inbox"
        Exit Sub
    End If

    '~~> Extract the attachment from the 1st unread email
    For Each oOlItm In oOlInb.Items.Restrict("[UnRead] = True")

    
        '~~> Check if the email actually has an attachment
        sSubj = oOlItm.Subject
        If Left(sSubj, 9) = "WD/CD DOR" Then
            If oOlItm.Attachments.Count <> 0 Then
                For Each oOlAtch In oOlItm.Attachments
                           
                        If Left(Right(oOlAtch.Filename, 5), 4) = ".xls" And Left(oOlAtch.Filename, 2) = "WD" Then
                            '~~> Download the attachment
                            oOlAtch.SaveAsFile NewFileName
                            Set wb = Workbooks.Open(NewFileName, UpdateLinks:=0)
                            i = i + 1
                            
                            Sheets("WDDP-A Daily Highlight").Select
                            
                            v_date = Range("L4")
                            value = Range("E33")
                            value1 = Range("E34")
                            
                            
                            Windows("WD DOR.xlsm").Activate
                            Sheets("list1").Select
                            Cells(i, 1).value = v_date
                            Cells(i, 2).value = value
                            Cells(i, 3).value = value1
                            
                            If i = 30 Or i = 100 Or i = 200 Or i = 300 Or i = 400 Then
                                ActiveWorkbook.Save
                            Else
                            End If
                            Application.DisplayAlerts = False
                            Workbooks("test1.xls").Close SaveChanges:=False
                            
                            
                            Else
                           ' MsgBox "attachment is not excel"
                        End If
                        'Exit For
                 Next
            Else
                'MsgBox "The First item doesn't have an attachment"
            End If
        Else
        End If
    
        
        oOlItm.UnRead = False
        'DoEvents
        'oOlItm.Save
    
    
    Next
         
 End Sub