Trying to use a MSGBox in my loop

[Eric Penfold]

The code below just loops through files and then sends them. But the MSGBox keeps appearing after I`ve send the Email? And the code will not end?
Also it produces a email for each file type all file types if finds needs all be in the same Email.

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
       
    Result = MsgBox("Do you need to Review text before sending?", vbQuestion + vbYesNo + vbDefaultButton2, "Need to Review Text Yes/No")
   
    If Result = vbYes Then
    .Display
    If Result = vbNo Then
    .Send
    End If
   
    End With
   
End Sub
Private 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
   
    For Each FSOFile In FSOFolder.Files
        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)
Next FSOFile

End Sub

 

[ranman256]

you have SENDEMAIL in the loop.
SENDEMAIL asks the question every time.
if you only want it to ask once, take the msgbox out of SENDEMAIL and put it above the loop. But the var Result must be public.


PUBLIC Result

Result = MsgBox("Do you need to Review text before sending?", vbQuestion + vbYesNo + vbDefaultButton2, "Need to Review Text Yes/No")
For Each FSOFile In FSOFolder.Files
next

 

[Eric Penfold]

Thanks that`s ace
But i now need all file types listed in code to be on 1 email?

 

[Eric Penfold]

Please could i have some help with the above thanks.