Auto Send Email from Excel 2007 No Error when Outlook 2007 is full

[Eric Lemont]

I have a macro that automatically sends email from excel 2007 through
outlook 2007. The problem is that if the user's outlook inbox is at
the size limit it will not send the email. When we were on Office
2003 my error handler worked to let the user know that the email
wasn't sent, but now on office 2007 it just doesn't send and doesn't
let the user know that the email did not go. The code also would
recognize an error if the email address was invalid in 2003, but that
does not work in 2007 either: just the email is not sent. My code is
below (most of it was from Ron de Bruin's code). Can anyone offer
some suggestions on this? Thanks

Dim iResponse As Integer
iResponse = MsgBox("Are you sure you want to send to current
customer?", vbYesNo, "Email All Customers")
If iResponse = vbYes Then


Application.DisplayAlerts = False
Sheets("Errors").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
Sheets.Add.Name = "Errors"
Sheets("Errors").Select
Sheets("Errors").Move After:=Sheets("Work")
Sheets("Errors").Select
ActiveCell.FormulaR1C1 = "Emails not Sent to Customers"
Columns("A:A").Select
With Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
End With
Selection.Font.Bold = True
Columns("A:A").EntireColumn.AutoFit
Range("B1").Select
ActiveCell.FormulaR1C1 = "=COUNTA(C[-1])"
Range("C1").Select
ActiveCell.FormulaR1C1 = "=RC[-1]>1"
Sheets("New Communication Template").Select
Range("D4").Select

Application.Run ("FilterCustomer")

Range("A1").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy
Sheets.Add
ActiveSheet.Name = ("Temp")
ActiveSheet.Paste
Selection.PasteSpecial Paste:=xlPasteColumnWidths,
Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Range("D4").Select
Selection.Validation.Delete
ActiveSheet.Shapes("Button 1").Select
Selection.Cut
ActiveCell.SpecialCells(xlLastCell).Select
Selection.Offset(2, -5).Select
' Application.Goto Reference:="Disclaimer"
' Application.CutCopyMode = False
' Selection.Copy
' Sheets("Temp").Select
' ActiveSheet.Paste
Range("A4").Select
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select

' Show the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = True

' Set the optional introduction field thats adds
' some header text to the email body. It also sets
' the To and Subject lines. Finally the message
' is sent.
With ActiveSheet.MailEnvelope
On Error GoTo ErrHandler
.Item.To = " "
.Item.CC = " "
.Item.Bcc = " "
.Item.Subject = " "
.Item.To = ActiveSheet.Range("B1")
.Item.Subject = ActiveSheet.Range("B2")
.Introduction = ActiveSheet.Range("B3")
.Item.Send
End With


' Hide the envelope on the ActiveWorkbook.
ActiveWorkbook.EnvelopeVisible = False
Application.DisplayAlerts = False
Sheets("Temp").Delete
Sheets("New Communication Template").Select
Range("D4").Select
Application.DisplayAlerts = True



Exit Sub

ErrHandler:
ActiveWorkbook.EnvelopeVisible = False
Application.DisplayAlerts = False
Sheets("Temp").Delete
Sheets("New Communication Template").Select
Selection.AutoFilter
Range("D4").Select
Application.DisplayAlerts = True
Sheets("New Communication Template").Select
Range("D4").Select
Selection.Copy
Sheets("Errors").Select
Range("A65536").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False
Sheets("New Communication Template").Select
Range("D4").Select

Sheets("Errors").Select
Range("A1").Select
If Range("C1").Value = False Then
Sheets("New Communication Template").Select
Range("D4").Select
Else
Sheets("New Communication Template").Select
Range("D4").Select
MsgBox "Some emails not sent to customers - check errors tab! Verify
email addresses for customer on GroupMatrix tab.", vbOKOnly +
vbExclamation, "Email Send Error!"
If vbOK Then
Sheets("Errors").Select
Range("A1").Select
Else
End If
End If

Else
End If

End Sub '