Email Check

[vmjan02]

I have this and is working all perfect, need to change 2 this.

1. should also check for subject as well with email ID (currently is only id)
2. after download should close the file and reopen the file after 1 hr 3 min Idea is the code to download the attachment ever hour so delay of 1 hr 3 min

Sub DownloadAttachment()
    
    Dim olApp As Object
    Dim olNamespace As Object
    Dim olFolder As Object
    Dim olItem As Object
    Dim olAttachment As Object
    Dim savePath As String

    ' Set the path where you want to save the attachment
    savePath = ActiveWorkbook.Path & "\" & "Hourly mail files\"

    ' Check if the specified folder exists, and create it if not
    If Dir(savePath, vbDirectory) = "" Then
        MkDir savePath
    End If

    ' Initialize Outlook
    Set olApp = CreateObject("Outlook.Application")
    Set olNamespace = olApp.GetNamespace("MAPI")

    ' Set the folder to the Inbox (you can change it to the appropriate folder)
    Set olFolder = olNamespace.GetDefaultFolder(6) ' 6 represents the Inbox

    ' Loop through the items in the folder
    For Each olItem In olFolder.Items
        ' Check if the email is from the specified sender
        If olItem.SenderEmailAddress = "xxx@xx" Then
            ' Loop through the attachments in the email
            For Each olAttachment In olItem.Attachments
                ' Check if the attachment is an Excel file
                If Right(olAttachment.fileName, 4) = ".xls" Or Right(olAttachment.fileName, 5) = ".xlsx" Then
                    ' Save the attachment to the specified path
                    olAttachment.SaveAsFile savePath & olAttachment.fileName
                End If
            Next olAttachment
        End If
    Next olItem

    ' Clean up
    Set olAttachment = Nothing
    Set olItem = Nothing
    Set olFolder = Nothing
    Set olNamespace = Nothing
    Set olApp = Nothing

End Sub

 

[vmjan02]

Hi everone,
Any update on it