attach file from folder on c:\ to outlook mail and send

hi norie have tried mostly rondebruin codes for email have few saved on notepad on laptop and various ones off net
most of them save from active workbook have had few nearly there jaslake gave me one but for some reason populates outlook but sends but does not arrive,but manually it does , like copy then paste attachment into outlook all fine

code below is from jaslake its saves to folder on c:as book1,book2 ectthen picks them up with mybooksfound,it populated outlook, sends
but does not arrive again,manually it does,at the minute there are6 books on c:folder ive merged into one but still does not work
cheers colin






Public myBooksFound() As Variant

Option Explicit
Sub Create_Files()
    Dim wsSh As Worksheet
    Dim MyPath As String
    Dim mySavePath As String
    Dim myBook As String
    Dim FileName As String
    Dim ws As Worksheets
    ReDim myBooksFound(0)

    MyPath = "C:\users\colin\Desktop\New\"          '<----Change this
    mySavePath = "C:\users\colin\Desktop\New\Temp\" '<----Change this

    On Error Resume Next
    'Kill "C:\Documents and Settings\Administrator\Desktop\New\Temp\*.xls*"  <----Change this

    On Error GoTo 0

    myBook = Dir(MyPath & "*.xls*")

    Do While myBook <> ""
        Workbooks.Open FileName:=MyPath & myBook

        For Each wsSh In ActiveWorkbook.Sheets
            If Not wsSh.Name = "Sheet1" Then
                Application.DisplayAlerts = False
                wsSh.Delete
                Application.DisplayAlerts = True
            End If
            FileName = ActiveWorkbook.Name
            Application.DisplayAlerts = False
            ActiveWorkbook.SaveAs FileName:=mySavePath & FileName
            Application.DisplayAlerts = True
        Next
        myBooksFound(UBound(myBooksFound)) = mySavePath & myBook
        ReDim Preserve myBooksFound(UBound(myBooksFound) + 1)
        Workbooks(myBook).Close SaveChanges:=False
        myBook = Dir
    Loop
    ReDim Preserve myBooksFound(UBound(myBooksFound) - 1)

    Call Mail_Sheets_Array

End Sub

Sub Mail_Sheets_Array()
    Dim Sourcewb As Workbook
    Dim OutApp As Object
    Dim OutMail As Object
    Dim i As Long
Dim ws As Worksheets
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set Sourcewb = ActiveWorkbook

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next
    With OutMail
        .To = "colin.finch17@sky.com"
        .CC = ""
        .BCC = ""
        .Subject = "This is the Subject line"
        .Body = "Hi therehu colin"

        For i = 0 To UBound(myBooksFound)
            .attachments.Add myBooksFound(i)
        Next

        .Display
        '            .Send   'or use .Display
    End With
    
     On Error GoTo 0
    Set OutMail = Nothing
    Set OutApp = Nothing
    
    
    
     
   ' Kill "c:\users\colin\desktop\new\temp\*.xlsx*"
   ' Kill "c:\users\colin\desktop\new\*.xlsx*"
   ' Set ws = Worksheets("completed")
'Sheet6.Cells.ClearContents
    
End Sub

hi norie
have sent you program see if you can send email with it then i know its this end dont no why it wont,have just done it
through sky manually 18 files and works
start it up click reports
enter 2 in ainscough ref click search
says theres 18click email contracts
click print contracts
and should populate out look
needs new folder on c:
and temp folder in new folder
cheers colin

hi norie
have just got it working fingers crossed looks like outlook and my sky email not set up properly together so looks like now works will check it on work computer
mon,new it could not be much as it worked for jaslake but not me
thanks for reply
cheers colin