SendMail Error Trapping

[NicB.]

I have tried for hours to figure this out to no avail. I am using
sendmail to mail the activeworkbook. Outlook pops up a message saying
someone is trying to send an email and click yes or no to accept or
deny. If I click "No", a run-time error occurs. I can suppress this
error with an on error statement, in facdt the code I wrote works fine
in a standalone worksheet, but when it is run in the complete code
(listed below), it fails.

I think I might have too many error traps and that somehow it is
causing a problem. I have labeled the error trap causing problems with
"NOCLUE". There are two other "on error" statements before hand, but I
don't understand how/why they are affecting things. I have also played
with indentation of the code, etc. The standalone bit of code for the
NOCLUE section works fine in a separate worksheet, so I am forced to
assume something else is causing error when I click no.

Any thoughts would be greatly appreciated!

NicB.

Sub Submit()

Application.ScreenUpdating = False

'Check to make sure no questions are left unanswered.

Dim Msg As Integer
Dim Result As Integer
Dim N As Integer

Dim WS As Worksheet, OBJ As OLEObject
Set WS = Worksheets("Risk Profiler")
Dim ComboBox As Object

For Each OBJ In WS.OLEObjects
If TypeOf OBJ.Object Is MsForms.ComboBox Then
If OBJ.Object.Value = "" Then
Msg = MsgBox("All questions have not been answered. Are
your sure you want to submit your risk profile? Click YES to
automatically generate an email with the results. Click NO to return
to the risk profile questionairre.", vbYesNo + vbExclamation,
"Submit?")
If Msg = 6 Then GoTo StartSendMail
Exit Sub
End If
End If
Next

'Submitting the profile

Msg = MsgBox("Are your sure you want to submit your risk profile?
Click YES to automatically generate an email with the results. Click
NO to return to the risk profile questionairre.", vbYesNo + vbQuestion,
"Submit?")

If Msg = 6 Then

StartSendMail:

'Backup the plotted answers

On Error GoTo ReadWriteFailure

ActiveWorkbook.Unprotect Password:="ses"
Worksheets("Answers").Visible = True
Worksheets("Answers").Select
Range("G6:G90").Select
Selection.Copy
Range("N6").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Worksheets("Answers").Visible = False
ActiveWorkbook.Protect Password:="ses", Structure:=True
Worksheets("Risk Profiler").Activate
Range("B14").Select

'Set up Workbook name and details for saving.

Dim WB1 As Workbook
Dim WB2 As Workbook
CompanyName = Worksheets("Start Here...").Range("D5").Value
YourName = Worksheets("Start Here...").Range("D7").Value
CEMName = Worksheets("Personnel").Range("C5").Value
RMName = Worksheets("Personnel").Range("C6").Value
PathName = Application.DefaultFilePath & "\Risk Profile for " &
YourName & " at " & CompanyName & ".xls"

'Take active workbook, save to Excel's default temporary location,
open that file
'with the updated name (Risk Profile from Anyone at
AnyCompany.xls), then sendmail,
'change the status of the file to Read-only so that no can mess
with it while it is
'being deleted, close the window, delete the file, and reactivate
the original file.

Set WB1 = ActiveWorkbook
WB1.SaveCopyAs PathName
Set WB2 = Workbooks.Open(PathName)
WB2.Activate
On Error GoTo CanceledEmail

With WB2

'Send the e-mail

SendMail Recipients:=Array("(e-mail address removed)"),
Subject:="Risk Profile from " & YourName & " at " & CompanyName

ActiveWorkbook.ChangeFileAccess xlReadOnly
ActiveWorkbook.Close
Kill PathName

End With

WB1.Activate
Msg = MsgBox("Your risk profile is being submitted. Thank
you!", vbOKOnly, "Confirmation")
GoTo ExitSendMail

ReadWriteFailure:

On Error GoTo NOCLUE
ActiveWorkbook.SendMail Recipients:=Array("(e-mail address removed)"),
Subject:="Risk Profile from " & YourName & " at " & CompanyName
Msg = MsgBox("Your risk profile is being submitted. Thank
you!", vbOKOnly, "Confirmation")
GoTo ExitSendMail

NOCLUE:

Msg = MsgBox("Your risk profile was not submitted to Summit. Please
click yes if prompted with with a security message from your email
client.", vbOKOnly, "Submission Failed")
GoTo ExitSendMail

CanceledEmail:
With WB2
ActiveWorkbook.ChangeFileAccess xlReadOnly
ActiveWorkbook.Close
Kill PathName
End With
WB1.Activate
Msg = MsgBox("Your risk profile was not submitted to Summit. Please
click yes if prompted with with a security message from your email
client.", vbOKOnly, "Submission Failed")

ExitSendMail:
End If
Application.ScreenUpdating = True

End Sub

 

[Ron de Bruin]

See
http://www.rondebruin.nl/mail/tips1.htm

Error-handling

If you click No on the Outlook security pop up screen that ask you
if it is OK to send the mail use this to avoid the error.

Sub test()
On Error Resume Next
ActiveWorkbook.SendMail "(e-mail address removed)", _
"This is the Subject line"
On Error GoTo 0
End Sub

 

[Hans Dummer]

I have a similar problem. But what I would like to so is to automatically
select YES when the question comes up. CAn you help.

 

[Ron de Bruin]

See
http://www.rondebruin.nl/mail/prevent.htm

 

[Hans Dummer]

Thank you for this. But how would i insert

..Display

Application.Wait (Now + TimeValue("0:00:02"))
Application.SendKeys "%S"

into

Sub xEmailing()
Workbooks.Open Filename:= _
"C:\Work Book Name.xls"

Windows("Work Book Name).xls").Activate
ActiveWorkbook.SendMail Recipients:="Email Adress"
ActiveWorkbook.Close
end sub

 

[Ron de Bruin]

Thank you for this. But how would i insert
Only if you use outlook object model code
See my site for example code

Do you use Outlook or Outlook Express ?

 

[Hans Dummer]

Thank you but I have figured it out and it is working great. Thank you for
your help

 

[Hans Dummer]

Dear Ron, This is all working now except when I use the following codes

..To = "(e-mail address removed);[email protected]"

The second email in the list bounces back saying undelivered. I think this
is due to the fact that the second email address only exsists in my Personal
contact section and not on the server. Do you have a way around this.

 

[Ron de Bruin]

Change the ; to , in the CDO example

In Outlook ; is working but not with CDO

 

[Ron de Bruin]

Mmmm

Try it again in CDO and it work with , and ;
let me know if it makes a different for you