Option Explicit

 Private Sub Application_NewMail()

    On Error GoTo GetAttachments_err
' Declare variables
    Dim ns As NameSpace
    Dim Inbox As MAPIFolder
    Dim Item As Object
    Dim Atmt As Attachment
    Dim FileName As String
    Dim i As Integer
    Set ns = GetNamespace("MAPI")
    Set Inbox = ns.GetDefaultFolder(olFolderInbox)
    i = 0
 'Check Inbox for messages and exit of none found
    If Inbox.Items.Count = 0 Then
        Exit Sub
    End If
' Check each message for attachments
    For Each Item In Inbox.Items
' Save any attachments found
        For Each Atmt In Item.Attachments
        ' This path must exist! Change folder name as necessary.
        If Left(Atmt.FileName, 10) = "Flat_file_" Then
            FileName = "G:\Input\" & Atmt.FileName
            Atmt.SaveAsFile FileName
            i = i + 1
         End If
         Next Atmt
    Next Item
 
 'Clear memory
GetAttachments_exit:
    Set Atmt = Nothing
    Set Item = Nothing
    Set ns = Nothing
    Exit Sub

GetAttachments_err:
    Resume GetAttachments_exit
End Sub