Email Attachment Problem

[EliseFreedman]

Hi there

I have a spreadsheet containing 500 users.

I am trying to send out a communication to them containing an attachment. I am using the code below.

when i run it, It attaches the attachment for the first lot of users then decides not to send the attachment with the email. Does anyone know why this would happen

Sub TestFile()
    Dim OutApp As Object
    Dim OutMail As Object
    Dim cell As Range

    Application.ScreenUpdating = False
    Set OutApp = CreateObject("Outlook.Application")
    OutApp.Session.Logon

   ' On Error GoTo cleanup
    For Each cell In Columns("D").Cells.SpecialCells(xlCellTypeConstants)
        If cell.Value Like "?*@?*.?*" And _
           LCase(Cells(cell.Row, "F").Value) = "yes" Then

            Set OutMail = OutApp.CreateItem(0)
            On Error Resume Next
            With OutMail
            .to = cell.Value
                .Subject = "Action Tracker Overview"
                   .Body = "Dear " & Cells(cell.Row, "A").Value _
                      & vbNewLine & vbNewLine & _
                        "Apologies" & vbNewLine & vbNewLine & _
                        "I have now attached the attachment" & vbNewLine & vbNewLine & _
                        "Kind Regards" & vbNewLine & vbNewLine & _
                        "Elise Freedman"
           .Attachments.Add ("h:\actiontrackercoms.doc")


                 .Send
            End With
            On Error GoTo 0
            Set OutMail = Nothing
        End If
        
        
    Next cell
    End Sub

 

[EliseFreedman]

Its ok. Sorted. I think its due to the size restraints on the mailbox at work