Trying to add specific file types to an Email

[Eric Penfold]

Trying to add all files specific types to an Email with a procedure at the moment it does a induvial email for each file type.

Sub Send_Email(EmailTo As String, EmailCC As String, EmailBCC As String, EmailSubject As String, EmailBody As String, EmailAttachment As String)
    Dim EmailApp As Object
    Dim EmailItem As Object
    Dim Source As String
    Dim Answer As String
    Dim Result As VbMsgBoxResult

    Set EmailApp = CreateObject("Outlook.Application")
    Set EmailItem = EmailApp.CreateItem(0)
    
    With EmailItem
        .To = EmailTo
        .CC = EmailCC
        .BCC = EmailBCC
        .Subject = EmailSubject
        .Body = EmailBody
        
        If EmailAttachment <> "" Then
            EmailItem.Attachments.Add EmailAttachment
        End If
    End With
    
End Sub
Public Sub Email_List_Click()

    Dim EmailApp As Object
    Dim EmailItem As Object
    Dim Source As String
    Dim Answer As String
    Dim FSOLibary As FileSystemObject
    Dim FSOFolder As Object
    Dim FSOFile As Object
    Dim strFolderCriteria As String, FolderName As String, strPath As String, strEmailList As String
    Dim xMailbody As String
    Dim Result As VbMsgBoxResult

    Set EmailApp = CreateObject("Outlook.Application")
    Set EmailItem = EmailApp.CreateItem(0)
    strFolderCriteria = (Me.Enter_Number.Value)
    strPath = "\\DF-AZ-FILE01\Company\R&D\Drawing Nos\Frost Grates"
    FolderName = strPath & "\" & strFolderCriteria
    Set FSOLibary = New Scripting.FileSystemObject
    Set FSOFolder = FSOLibary.GetFolder(FolderName)
    
    If FSOFolder = "" Then
        MsgBox ("Please Retype The Part Number on Form")
        Unload Me
        Exit Sub
    End If
    
    Select Case Time
        Case Is < TimeValue("12:00:00")
            xMailbody = "Good Morning"
        Case Is < TimeValue("17:00:00")
            xMailbody = "Good Afternoon"
    End Select
    
    With EmailItem
        For Each FSOFile In FSOFolder.Files
            Answer = MsgBox("Do you need to Review text before sending?", vbQuestion + vbYesNo + vbDefaultButton2, "Need to Review Text Yes/No")
            If Answer = vbYes Then
            If (FSOFile.Name Like "*" & ".STEP" Or FSOFile.Name Like "*" & ".DXF" Or FSOFile.Name Like "*" & ".JPG") Then _
                Call Send_Email(Me.Email_List.Value, "", "", "Dr.No." & " " & Me.Enter_Number.Value & " " & "Date Sent" & " " & Format(Date, "dd/mm/yyyy"), _
                xMailbody & "," & vbNewLine & vbNewLine & "Process Frost Drawings." & vbNewLine & vbNewLine & "Kind Regards,", FSOFolder.Path & Application.PathSeparator & FSOFile.Name)
                .Display
            Else
                If (FSOFile.Name Like "*" & ".pdf" Or FSOFile.Name Like "*" & ".STEP" Or FSOFile.Name Like "*" & ".DXF" Or FSOFile.Name Like "*" & ".JPG") Then _
                    Call Send_Email(Me.Email_List.Value, "", "", "Dr.No." & " " & Me.Enter_Number.Value & " " & "Date Sent" & " " & Format(Date, "dd/mm/yyyy"), _
                    xMailbody & "," & vbNewLine & vbNewLine & "Process Frost Drawings." & vbNewLine & vbNewLine & "Kind Regards,", FSOFolder.Path & Application.PathSeparator & FSOFile.Name)
            End If
        Next FSOFile
        .Send
        
    End With
    
End Sub