Method 'MailEnvelope' of object '_Worksheet' failed

[consulttech2004]

Greetings!

The code below works once (the first time). The second time it runs,
it gives this error:

Run-time error '-2147467259 (80004005)':
Method 'MailEnvelope' of object '_Worksheet' failed

Debugging shows that the code is failing at

With Application.ActiveSheet.MailEnvelope

Outlook 2003 is my mail client.

I am using Excel 2003.

I have set a reference to Microsoft Outlook 11.0.

I have verified through Task Manager/Processes that there is not a
separate process of Outlook or Excel "hanging."

Microsoft Word is not my email editor.

On other groups, I have seen similar posts about this problem with no
solution. Has anyone run across this, and has anyone come up with a
solution?

I can see a security risk for all this (looping through a list of
addresses and sending mail without a security warning.) Thanks.

Option Explicit
Sub SendFile()

Dim wkb1 As Workbook
Dim wkb2 As Workbook
Dim wks1 As Worksheet
Dim rng1 As Range
Dim strEmail As String

strEmail = "(e-mail address removed)"

Set wkb1 = Application.ActiveWorkbook
Set rng1 = Selection
rng1.Copy
Sheets.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Set wks1 = wkb1.ActiveSheet

Debug.Print wks1.Name

Call usbSendMail(strEmail)

wks1.Delete

End Sub

Sub usbSendMail(strRecipient As String)

'Use a With...End With block to reference the MsoEnvelope object.
With Application.ActiveSheet.MailEnvelope

'Add some introductory text before the body of the e-mail.
.Introduction = "Please read this and send me your comments."

'Return a Microsoft Outlook MailItem object that
'you can use to send the document.
With .Item

'All of the mail item settings are saved with the document.
'When you add a recipient to the Recipients collection
'or change other properties, these settings will persist.
.Recipients.Add strRecipient
.Subject = "Here is the document."

'The body of this message will be
'the content of the active document.
.Send
End With
End With
End Sub

 

[Eric Legault [MVP - Outlook]]

I've modified your code to add better error handling, and to account for
situations when the user may not click the Yes button to approve sending the
e-mail. Also, you do not need a reference to the Outlook Object Model
because it is not being used. The msoEnvelope class is a member of the
Office Object Model.

Option Explicit

Sub SendFile()

Dim wkb1 As Workbook
Dim wkb2 As Workbook
Dim wks1 As Worksheet
Dim rng1 As Range
Dim strEmail As String

strEmail = "(e-mail address removed)"

Set wkb1 = Application.ActiveWorkbook
Set rng1 = Selection
rng1.Copy
Sheets.Add
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Set wks1 = wkb1.ActiveSheet

Debug.Print wks1.Name

If usbSendMail(strEmail) = True Then
wks1.Delete
End If

End Sub

Function usbSendMail(strRecipient As String) As Boolean
On Error Resume Next

Dim objItem As Object

Set objItem = Application.ActiveSheet.MailEnvelope.Item
'Use a With...End With block to reference the MsoEnvelope object.

If objItem Is Nothing Then
MsgBox "Error returning the MailEnvelope object.", vbOKOnly +
vbExclamation
GoTo Leave:
End If

With Application.ActiveSheet.MailEnvelope

'Add some introductory text before the body of the e-mail.
.Introduction = "Please read this and send me your comments."

'Return a Microsoft Outlook MailItem object that
'you can use to send the document.
With objItem

'All of the mail item settings are saved with the document.
'When you add a recipient to the Recipients collection
'or change other properties, these settings will persist.
.Recipients.Add strRecipient
.Subject = "Here is the document."

'The body of this message will be
'the content of the active document.
.Send
If Err.Number <> 0 Then
MsgBox "You cancelled the send message prompt.", vbOKOnly +
vbExclamation
Else
usbSendMail = True
End If
End With
End With

Leave:
Set objItem = Nothing
End Function