item.send security dialog box

[cheaptrix]

Hello.

I have a macro set up to send a worksheet that is linked to a shape on the worksheet. When I send the "A program is trying to automatically send e-mail on your behalf" security warning pops up. Currently when the "No" button is clicked it generates "Application-defined or object-defined error" box. Is it possible to code the "No" button to simply exit sub?

Thank you.

[mdmackillop]

Can you post your code?

[cheaptrix]

Sure, thanks for responding. Here is the mail send portion which I believe I got from this very site. I can't remember the author but it has served me well. Thanks!


Dim OL, EmailItem As Object
Dim y As Long
Dim x, Filename, TempChar, SaveName, msg, msg2, repName, curDate, rtaId, callId, FileSave As String

'initialize and set savename

Application.ScreenUpdating = False
Set OL = CreateObject("Outlook.Application")
Set EmailItem = OL.CreateItem(olMailItem)
Filename = ActiveSheet.Name & " - " & ActiveWorkbook.Name
For y = 1 To Len(Filename)
TempChar = Mid(Filename, y, 1)
Select Case TempChar
Case Is = "/", "\", "*", "?", """", "<", ">", "|"
Case Else
SaveName = SaveName & TempChar
End Select
Next y
Worksheets("sheet1").Cells.Copy
Workbooks.Add

'paste cells into new worksheet, hide gridlines

Selection.PasteSpecial Paste:=xlValues
Selection.PasteSpecial Paste:=xlFormats
ActiveWindow.DisplayGridlines = False


'save workbook

ActiveWorkbook.SaveAs "C:\test\" & repName & "-" & "daily.scorecard" & "-" & Format(curDate, "mm-dd-yyyy") & ".xls"
FileSave = "C:\test\" & repName & "-" & "daily.scorecard" & "-" & Format(curDate, "mm-dd-yyyy") & ".xls"



'create email item setting subject line, body, To: field, CC: field, Importance
'add previously saved file as an attachment
'send email

With EmailItem
.Subject = "Score card for " & repName & " - " & "Date: " & Format(curDate, "mm-dd-yyyy")
.Body = "The daily score card for: " & repName & " is attached."
.To = "test@test.com"
.CC = ""
.Importance = olImportanceNormal
.Attachments.Add "C:\test\" & repName & "-" & "daily.scorecard" & "-" & Format(curDate, "mm-dd-yyyy") & ".xls"
.Send
End With

ActiveWorkbook.Close False

Application.ScreenUpdating = True

Set OL = Nothing
Set EmailItem = Nothing

End Sub

[cheaptrix]

Not possible?

[MikeBlackman]

Hi,

Check out Ron de Bruins site to see if there is anything there that can help, all the mailers i've used from his site have avoided this dialog box as they use the built in mailer within Excel.

http://www.rondebruin.nl/sendmail.htm

[GTO]

Greetings cheaptrix,


...Currently when the "No" button is clicked it generates "Application-defined or object-defined error" box. Is it possible to code the "No" button to simply exit sub?

I think you should be able to do this thru a little error handling. In a throwaway copy of your wb, try:

(Please note the adaptations I made for testing; change to suit...)

Option Explicit
Sub ex()
'// Just a short example to hopefully help with your question; I did not try to //
'// replicate all that your code does...just the basics... //

Dim OL As Object 'or Outlook.Application if Early Bound...
Dim EmailItem As Object 'or Outlook.MailItem SAA...
'// Just in case you were not aware, excepting 'FileSave', all of these are Variants, //
'// not String type variables. //
'Dim x, Filename, TempChar, SaveName, msg, msg2, repName, curDate, rtaId, callId, FileSave As String
'// To declare these as String (or whatever)... //
'Dim x As String, Filename As String, TempChar As String, SaveName As String, msg As String '//etc//
Dim wbNew As Workbook
Dim Filename As String

Set OL = CreateObject("Outlook.Application")

'// You dimensioned OL and EmailItem as Objects at the top. If you are going to //
'// use Late Binding (no intellisense while writing, but less problematic later, so //
'// good idea IMHO), then we need to find the value of any Outlook Constants and use//
'// the value rather than the Constant. //

'Set EmailItem = OL.CreateItem(olMailItem)
Set EmailItem = OL.CreateItem(0)

'// Now I may well be misunderstanding what the goal is, but it looked to me as is //
'// you are wanting to make a new WB out of "Sheet1" and attach it to an email. IF //
'// that is correct, I would think we'd want to want to refer to Sheet1 right off, //
'// rather than the activesheet here and sheet1 farther down. Of course disregard //
'// if I'm off track... //

'Filename = ActiveSheet.Name & " - " & ActiveWorkbook.Name


'// added just to toss some vals on sheet1//
ThisWorkbook.Worksheets("Sheet1").Range("A1:I42").FormulaArray = "Test"

'// You could just make a one sheet workbook from Sheet1 if desired //

'// Change to suit, just temped in a path to test... //
Filename = ThisWorkbook.Path & "\" _
& ThisWorkbook.Worksheets("Sheet1").Name & " - " & ThisWorkbook.Name

'// Copy Sheet1 (or whatever) to a new unsaved wb and set a reference to it. //
ThisWorkbook.Worksheets("Sheet1").Copy
Set wbNew = ActiveWorkbook

With wbNew
'// The new wb will only be a one-sheet wb comprised of Sheet1, and will only //
'// have one window at this point, so I think this replicates what you did here.//
.Windows(1).DisplayGridlines = False
.SaveAs Filename:=Filename
.Close False
End With

With EmailItem
'// Change to suit, I just rem'd out parts I didn't have... //
.Subject = "Score card for " '& repName & " - " & "Date: " & Format(curDate, "mm-dd-yyyy")
.Body = "The daily score card for: " '& repName & " is attached."
.To = "test@test.com"
.CC = ""
.Importance = 1 'or olImportanceNormal if early bound
.Attachments.Add Filename
.Display

'// Reference your question, lets see if handling the error created by pressing //
'// the <No> button does the trick. //
On Error GoTo SendCancelledErr
.Send
On Error GoTo 0
End With

Set OL = Nothing
Set EmailItem = Nothing
'// If user pressed <Yes> button and there is no error, we need to exit the sub prior //
'// to the error handling. //
Exit Sub
'// If user pressed <No>, we'll jump from .Send to here and process error handling. //
SendCancelledErr:
'// optional, close the created msg w/o saving. //
EmailItem.Close 1 'or olDiscard if Early bound

Set OL = Nothing
Set EmailItem = Nothing

'// "Application-defined or object-defined error" = error number 287. //
If Err.Number = 287 Then
MsgBox "You cancelled programmatic access; I cannot send" & vbCrLf & _
"the newly created msg and attachment." _
, vbInformation, vbNullString
End If
End Sub


Hope this helps,

Mark

[cheaptrix]

Very good! Thanks for your help. Sorry it took so long to respond...new baby.

-cheap

[GTO]

Very good! Thanks for your help. Sorry it took so long to respond...new baby.

-cheap

Well Congratulations and God Bless :beerchug: :ole:

Mark