vba - Extract only excel documents from an email message

Question

I have the below code which works great, extracts attachments from all emails that are stored in a folder. I only want to extract the .xlsx files from the emails. I don't know how to modify the code to only select the .xlsx files.

Thanks,

Public Sub Extract_Attachments_From_Outlook_Msg_Files()

    Dim outApp As Object
    Dim outEmail As Object
    Dim outAttachment As Object
    Dim msgFiles As String
    Dim sourceFolder As String
    Dim saveInFolder As String
    Dim fileName As String
    
    'CHANGE - folder location and filespec of .msg files
    msgFiles = ""
    'CHANGE - folder where extracted attachments are saved
    saveInFolder = ""
          
    On Error Resume Next
    Set outApp = GetObject(, "Outlook.Application")
    If outApp Is Nothing Then
        MsgBox "Outlook is not open"
        Exit Sub
    End If
    On Error GoTo 0
    
    fileName = Dir(msgFiles)
    While fileName <> vbNullString
        
        'Open .msg file in Outlook 2003
        'Set outEmail = outApp.CreateItemFromTemplate(sourceFolder & fileName)
        
        'Open .msg file in Outlook 2007+
        Set outEmail = outApp.Session.OpenSharedItem(sourceFolder & fileName)
        
        For Each outAttachment In outEmail.Attachments
            outAttachment.SaveAsFile saveInFolder & outAttachment.fileName
        Next
    
        fileName = Dir
        
    Wend
    
End Sub

Answer 1

等待大神答复