View Single Post
  #4   Report Post  
Posted to microsoft.public.excel.programming
Ron de Bruin Ron de Bruin is offline
external usenet poster
 
Posts: 11,123
Default SendMail Error Trapping

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 ?


--
Regards Ron De Bruin
http://www.rondebruin.nl



"Hans Dummer" wrote in message ...
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

--
Thank you in advance for your Help


"Ron de Bruin" wrote:

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

--
Regards Ron De Bruin
http://www.rondebruin.nl



"Hans Dummer" wrote in message ...
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.

--
Thank you in advance for your Help


"NicB." wrote:


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", Structu=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 "),
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

ReadWriteFailu

On Error GoTo NOCLUE
ActiveWorkbook.SendMail "),
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


--
NicB.
------------------------------------------------------------------------
NicB.'s Profile: http://www.excelforum.com/member.php...o&userid=20639
View this thread: http://www.excelforum.com/showthread...hreadid=549953