VBA to Save file from Outlook

[Rpaikh]

Hello Experts,


I'm looking for a VBA to save files from specific folder in Outlook and found below code from this forum and it works just fine.

However,

- The code just save only the first file of the first email >>> I would like to save all file for all unread email
- It always save and combine under .XLSX format >>> How can I save those file as original name & original format type
>>> How can I set a criteria to save only specific format i.e. only save .xlsx files out of all the file in that email

Sub do_something_cool()



'Create the file path where I want the file saved
    Dim AttachementPath As String: Dim NewFileName As String: Dim NewFileName2 As String
        AttachementPath = "C:\Users\paikhr\Desktop\test\"  'think about creating environ$ or make this folder if not there
        NewFileName = AttachementPath & "Daily Reporting File " & Format(Date, "MM-DD_YY") & ".xlsx"
        


Dim olApp As Outlook.Application
Dim ns As Outlook.Namespace
Dim Inbox_Prog_Pace As MAPIFolder


Dim Item As Object
Dim PaceFile As Attachment


    Set ns = GetNamespace("MAPI")
    Set Inbox_Prog_Pace = ns.GetDefaultFolder(olFolderInbox).Folders("Milot").Folders("GR PK RM")
    
'Check the pacing file folder for an unread email
'If there are no undread emails then display a message
    If Inbox_Prog_Pace.Items.Restrict("[UnRead] = True").Count = 0 Then
        MsgBox "The pacing file has already been read and will not be downloaded"
        Exit Sub
    End If


'Get the attachement from the 1st unread email
    For Each Item In Inbox_Prog_Pace.Items.Restrict("[Unread] = True")
        'checking if there is actually an attachment
        If Item.Attachments.Count <> 0 Then
            For Each PaceFile In Item.Attachments
                PaceFile.SaveAsFile NewFileName 'need to save as .csv on order to open the file out of the folder - other types or blank do not work
            Exit For
        Next
        Else
            MsgBox "There is not an attachment in the email, please QA"
        End If
        
        Item.UnRead = False
        DoEvents
        Item.Save
        
        Exit For
    Next
    
End Sub

 

[Rpaikh]

Could anyone help me please.