For some reason when I create a Email and add filles it Duplicates all the files??

[Eric Penfold]

Seems to loop though folder file 2 times?

Private Sub Email_Files_Click()

        Dim objol     As Object
        Dim objmail   As Object
        Dim objFolder As Object
        Dim FSOLibary As FileSystemObject, FSOFolder As Object, FSOFile As Object
        Dim FolderName As String
        Dim SourcePath As String
        Dim SubPath As String
        Dim PdfFolder As Folder
        Dim PdfFile As String
        Dim MyPath As String
        Dim PDFFName As String
        Dim xMailbody As String
        Dim Morning_Afternoon As String
        Dim cmbdataas As String
        Dim Answer As String
        Dim xFile As String
        Dim Count As Long

  
    Set objol = CreateObject("Outlook.Application")
    Set objmail = objol.CreateItem(0)
   
    cmbdata = Split(Me.OpenDrawing.Value, "-")
    cmbdata(0) = Replace(cmbdata(0), "-", "")
   
    SourcePath = "S:\R&D\Drawing Nos"
   
      Answer = MsgBox("Do you need model Drawings", vbQuestion + vbYesNo + vbDefaultButton2, "Need Models Yes/No")
   
    If Val(cmbdata(0)) >= 10001 And Val(cmbdata(0)) <= 10050 Then
        SubPath = "10001-10050"
    ElseIf Val(cmbdata(0)) >= 10051 And Val(cmbdata(0)) <= 10100 Then
        SubPath = "10051-10100"
    ElseIf Val(cmbdata(0)) >= 10101 And Val(cmbdata(0)) <= 10150 Then
        SubPath = "10101-10150"
    ElseIf Val(cmbdata(0)) >= 10151 And Val(cmbdata(0)) <= 10200 Then
        SubPath = "10151-10200"
    End If

    FolderName = SourcePath & "\" & SubPath & "\" & Int(cmbdata(0))
    Set FSOLibary = New Scripting.FileSystemObject
    Set FSOFolder = FSOLibary.GetFolder(FolderName)
    Set FSOFile = FSOFolder.Files


    If Time < TimeValue("12:00:00") Then
    xMailbody = "Good Morning"
    ElseIf Time > TimeValue("12:00:00") And Time < TimeValue("17:00:00") Then
    xMailBoby = "Good Afternoon"
    End If
   
     With objmail
        .To = Email_Supplier.Value
        .cc = ""
        .BCC = ""
        .Subject = "All Files to Send" & " " & Format(Date, "dd/mmmm/yyyy")
        .Display
        .HTMLBody = xMailBoby & "," & _
        "<p> Please see Attached files to Process <P>" & _
        "Please see Attached files to Quote for<P>" & _
        "Mt"
    
            If Answer = vbYes Then
            For Each FSOFile In FSOFolder.Files
            If FSOFile.Name Like "*" & ".SLDPRT" Then
            Attached_File = FSOFile
            .Attachments.Add Attached_File
            ElseIf FSOFile.Name Like "*" & ".SLDASM" Then
            Attached_File = FSOFile
            .Attachments.Add Attached_File
           
            End If
            Next FSOFile
            End If
           
            If Answer = vbNo Then
            For Each FSOFile In FSOFolder.Files
            If FSOFile.Name Like "*" & ".DXF" Then
            Attached_File = FSOFile
            .Attachments.Add Attached_File
            ElseIf FSOFile.Name Like "*" & ".pdf" Then
            Attached_File = FSOFile
            .Attachments.Add Attached_File
            End If
            Next FSOFile
            End If
End With

        Unload Me
       

       
End Sub

 

[Eric Penfold]

Any chance of some help today?

 

[RoryA]

I can't see how it would add the same file twice. If you had files with the same name but different extension you could get both.

 

[Eric Penfold]

Would you like me to send you the workbook?

 

[RoryA]

Can you put it on a file sharing site and post a link?

 

[Eric Penfold]

I`ve now found a way to stop duplicates. But thanks for you time