The dilemma with automatically sending Emails from Outlook: With attachment=Yes - but only with text in the body=Maybe?

E

ECKSELL

New Member
Joined
Feb 28, 2008
Messages
9
Hi,
I have been browsing the Web for a solution to the dilemma to send a mail directly from Excel without having to click “Yes” on the security pop up window and avoid sending the content as an attachment. <?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
<o:p></o:p>
At the moment I have two working examples of VBA code which “together” will do the trick – but I wonder how I can merge the two examples in order to “Automatically send a mail with only text in the body – where the text is picked up from the Excel sheet (for example the cells A1:A50 in a specific Sheet called “Presentation” in the active Excel file named “CompanyNumbers.xls) <o:p></o:p>
<o:p></o:p>
The trick is to avoid sending information as an attachment – and avoiding pop up security warning in Excel<o:p></o:p>
<o:p></o:p>
At the moment I have two working solutions where the first example show how to avoid the security warning – and the second example below shows how to sent plain text in the body of the mail. (instead of using an attachment).<o:p></o:p>
<o:p></o:p>
BUT: How can these two requirements be used together? It is a mysterious for me!<o:p></o:p>
<o:p></o:p>
  • The first working VBA code actually send an automatic mail (but with an attacment) without having to click “Yes”. The solutions works if you make sure to toggle the “Microsoft Office 11.0 Object Library” in (Excel=>Tools=>Visual Basic Editor=>Tools=>References). The working VBA code is displayed below in the first example. The problem is that I don't want to send the attached file - I would like to send plain text in the mail body instead.
<o:p></o:p>
  • The second working VBA code works perfectly to Email the text in the body where the sent text is for example the cells A1:A50 in the sheet named “Presentation” in the Excel file called “CompanyNumbers.xls . The solution is based on Mr Ron de Bruin excellent example reffered to many, many times on different forums. BUT the problem is that this VBA code requires to manually click “Yes” to the pop up window unless you use some “external” modifications like CDO etc.<o:p></o:p>
<o:p></o:p>
OK - I have seen different comments on different Excel forums like:<o:p></o:p>
<o:p></o:p>
a) “It is not possible to bypass the security message unless you use CDO or ask your Admin people to change the firewalls etc.<o:p></o:p>
However: The first VBA code is an example that this is not the case. Or?<o:p></o:p>
<o:p></o:p>
b) I have also seen comments that if you want to send plain text – there are limitations of 225 characters etc.<o:p></o:p>
However: The second VBA code below proves that this is not the case because the used function is a good work around. Or?<o:p></o:p>
<o:p></o:p>
=> My question is if there are any smart people out there in the VBA world who can guide me how to get a working VBA code which combine the two VBA codes above? (To Email only text + bypass the security message in Outlook)<o:p></o:p>
<o:p></o:p>
Thanks, <o:p></o:p>
ECKSELL




Below is a working VBA code to automatically Email an attached file without having to click "Yes" on the pop up window in Outlook:

Rich (BB code): 
Sub Send_an_attachment()<o:p></o:p>
<o:p></o:p>
Dim objol As New Outlook.Application<o:p></o:p>
Dim objmail As MailItem<o:p></o:p>
Set objol = New Outlook.Application<o:p></o:p>
Set objmail = objol.CreateItem(olmailitem)<o:p></o:p>
With objmail<o:p></o:p>
.To = "firstname.lastname@company.com"<o:p></o:p>
.cc = "firstname.lastname@company.com "<o:p></o:p>
.Subject = "The Yearly Company Numbers"<o:p></o:p>
.Body = "Hi, In the Cells A1:A50 you see the Yearly Company Numbers"<o:p></o:p>
.NoAging = True<o:p></o:p>
.Attachments.Add ("C:\CompanyNumbers.xls")<o:p></o:p>
.Display<o:p></o:p>
End With<o:p></o:p>
Set objmail = Nothing<o:p></o:p>
Set objol = Nothing<o:p></o:p>
SendKeys "%{s}", True<o:p></o:p>
<o:p></o:p>
End Sub<o:p></o:p>

Below is a working VBA code to automatically Email plain text from specific cells in a specific active .xls file - but where the problem is that the pop up window in Outlook must manually be clicked "Yes" before sending the Email:

<o:p>
Rich (BB code): 
</o:p>
 
<o:p>Sub Mail_text_in_body()<o:p></o:p>
' Don't forget to copy the function RangetoHTML in the module.<o:p></o:p>
' Working in Office 2000-2007<o:p></o:p>
Dim rng As Range<o:p></o:p>
Dim OutApp As Object<o:p></o:p>
Dim OutMail As Object<o:p></o:p>
<o:p></o:p>
Set rng = Nothing<o:p></o:p>
On Error Resume Next<o:p></o:p>
'Only the visible cells in the selection<o:p></o:p>
'Set rng = Selection.SpecialCells(xlCellTypeVisible)<o:p></o:p>
'You can also use a range if you want<o:p></o:p>
Set rng = Sheets("Presentation").Range("A1:A50").SpecialCells(xlCellTypeVisible)<o:p></o:p>
On Error GoTo 0<o:p></o:p>
<o:p></o:p>
If rng Is Nothing Then<o:p></o:p>
MsgBox "The selection is not a range or the sheet is protected" & _<o:p></o:p>
       vbNewLine & "please correct and try again.", vbOKOnly<o:p></o:p>
Exit Sub<o:p></o:p>
End If<o:p></o:p>
<o:p></o:p>
With Application<o:p></o:p>
.EnableEvents = False<o:p></o:p>
.ScreenUpdating = False<o:p></o:p>
End With<o:p></o:p>
<o:p></o:p>
Set OutApp = CreateObject("Outlook.Application")<o:p></o:p>
OutApp.Session.Logon<o:p></o:p>
Set OutMail = OutApp.CreateItem(0)<o:p></o:p>
<o:p></o:p>
On Error Resume Next<o:p></o:p>
With OutMail<o:p></o:p>
.To = "firstname.lastname@company.com"<o:p></o:p>
.cc = "firstname.lastname@company.com "<o:p></o:p>
.BCC = ""<o:p></o:p>
.Subject = "The Yearly Company Numbers"<o:p></o:p>
.HTMLBody = RangetoHTML(rng)<o:p></o:p>
.Send   'or use .Display<o:p></o:p>
End With<o:p></o:p>
On Error GoTo 0<o:p></o:p>
<o:p></o:p>
With Application<o:p></o:p>
.EnableEvents = True<o:p></o:p>
.ScreenUpdating = True<o:p></o:p>
End With<o:p></o:p>
<o:p></o:p>
Set OutMail = Nothing<o:p></o:p>
Set OutApp = Nothing<o:p></o:p>
End Sub<o:p></o:p>
<o:p></o:p>
Function RangetoHTML(rng As Range)<o:p></o:p>
' Changed by Ron de Bruin 28-Oct-2006<o:p></o:p>
' Working in Office 2000-2007<o:p></o:p>
Dim fso As Object<o:p></o:p>
Dim ts As Object<o:p></o:p>
Dim TempFile As String<o:p></o:p>
Dim TempWB As Workbook<o:p></o:p>
<o:p></o:p>
TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"<o:p></o:p>
<o:p></o:p>
'Copy the range and create a new workbook to past the data in<o:p></o:p>
rng.Copy<o:p></o:p>
Set TempWB = Workbooks.Add(1)<o:p></o:p>
With TempWB.Sheets(1)<o:p></o:p>
.Cells(1).PasteSpecial Paste:=8<o:p></o:p>
.Cells(1).PasteSpecial xlPasteValues, , False, False<o:p></o:p>
.Cells(1).PasteSpecial xlPasteFormats, , False, False<o:p></o:p>
.Cells(1).Select<o:p></o:p>
Application.CutCopyMode = False<o:p></o:p>
On Error Resume Next<o:p></o:p>
.DrawingObjects.Visible = True<o:p></o:p>
.DrawingObjects.Delete<o:p></o:p>
On Error GoTo 0<o:p></o:p>
End With<o:p></o:p>
<o:p></o:p>
'Publish the sheet to a htm file<o:p></o:p>
With TempWB.PublishObjects.Add( _<o:p></o:p>
 SourceType:=xlSourceRange, _<o:p></o:p>
 Filename:=TempFile, _<o:p></o:p>
 Sheet:=TempWB.Sheets(1).Name, _<o:p></o:p>
 Source:=TempWB.Sheets(1).UsedRange.Address, _<o:p></o:p>
 HtmlType:=xlHtmlStatic)<o:p></o:p>
.Publish (True)<o:p></o:p>
End With<o:p></o:p>
<o:p></o:p>
'Read all data from the htm file into RangetoHTML<o:p></o:p>
Set fso = CreateObject("Scripting.FileSystemObject")<o:p></o:p>
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)<o:p></o:p>
RangetoHTML = ts.ReadAll<o:p></o:p>
ts.Close<o:p></o:p>
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _<o:p></o:p>
                  "align=left x:publishsource=")<o:p></o:p>
<o:p></o:p>
'Close TempWB<o:p></o:p>
TempWB.Close savechanges:=False<o:p></o:p>
<o:p></o:p>
'Delete the htm file we used in this function<o:p></o:p>
Kill TempFile<o:p></o:p>
<o:p></o:p>
Set ts = Nothing<o:p></o:p>
Set fso = Nothing<o:p></o:p>
Set TempWB = Nothing<o:p></o:p>
End Function<o:p></o:p>
<o:p></o:p></o:p>
<o:p></o:p>
<o:p></o:p>
<o:p></o:p>
<o:p></o:p>
<o:p>
<o:p></o:p>
</o:p>
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
Sort by date Sort by votes
And here is your second piece of code modified to use the Redemption object library to bypass the Outlook security message. Obviously you need to download and install Redemption before it will work.
Code: 
Sub Mail_text_in_body()
' Don't forget to copy the function RangetoHTML in the module.
' Working in Office 2000-2007
Dim rng As Range
Dim OutApp As Object
Dim OutMail As Object
Dim SafeItem As Object

Set rng = Nothing
On Error Resume Next
'Only the visible cells in the selection
'Set rng = Selection.SpecialCells(xlCellTypeVisible)
'You can also use a range if you want
Set rng = Sheets("Presentation").Range("A1:A50").SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rng Is Nothing Then
MsgBox "The selection is not a range or the sheet is protected" & _
       vbNewLine & "please correct and try again.", vbOKOnly
Exit Sub
End If

With Application
.EnableEvents = False
.ScreenUpdating = False
End With

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
Set SafeItem = CreateObject("Redemption.SafeMailItem")
SafeItem.Item = OutMail

On Error Resume Next
With SafeItem
.To = "firstname.lastname@company.com"
.cc = "firstname.lastname@company.com "
.BCC = ""
.Subject = "The Yearly Company Numbers"
.HTMLBody = RangetoHTML(rng)
.Send   'or use .Display
End With
On Error GoTo 0

With Application
.EnableEvents = True
.ScreenUpdating = True
End With

Set OutMail = Nothing
Set OutApp = Nothing
Set SafeItem = Nothing

End Sub

Function RangetoHTML(rng As Range)
' Changed by Ron de Bruin 28-Oct-2006
' Working in Office 2000-2007
Dim fso As Object
Dim ts As Object
Dim TempFile As String
Dim TempWB As Workbook

TempFile = Environ$("temp") & "/" & Format(Now, "dd-mm-yy h-mm-ss") & ".htm"

'Copy the range and create a new workbook to past the data in
rng.Copy
Set TempWB = Workbooks.Add(1)
With TempWB.Sheets(1)
.Cells(1).PasteSpecial Paste:=8
.Cells(1).PasteSpecial xlPasteValues, , False, False
.Cells(1).PasteSpecial xlPasteFormats, , False, False
.Cells(1).Select
Application.CutCopyMode = False
On Error Resume Next
.DrawingObjects.Visible = True
.DrawingObjects.Delete
On Error GoTo 0
End With

'Publish the sheet to a htm file
With TempWB.PublishObjects.Add( _
 SourceType:=xlSourceRange, _
 Filename:=TempFile, _
 Sheet:=TempWB.Sheets(1).Name, _
 Source:=TempWB.Sheets(1).UsedRange.Address, _
 HtmlType:=xlHtmlStatic)
.Publish (True)
End With

'Read all data from the htm file into RangetoHTML
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)
RangetoHTML = ts.ReadAll
ts.Close
RangetoHTML = Replace(RangetoHTML, "align=center x:publishsource=", _
                  "align=left x:publishsource=")

'Close TempWB
TempWB.Close savechanges:=False

'Delete the htm file we used in this function
Kill TempFile

Set ts = Nothing
Set fso = Nothing
Set TempWB = Nothing
End Function
 
Upvote 0
Thanks for the information about RDO:<?xml:namespace prefix = o ns = "urn:schemas-microsoft-com:eek:ffice:eek:ffice" /><o:p></o:p>
BUT: The "dilemma" here is that I would like to send an automatic mail without having to install any programs etc. (like RDO) which my admin people in my "big" company will not like. The idea with my Excel sheet is that several people in the company will us it and I would like to be able to give them the Excel file including the VBA code – and user shall be able to use it right away (without having to do anything except make sure to have the correct e-mail address defined) <o:p></o:p>
<o:p></o:p>
Question: <o:p></o:p>
In my first VBA code example above – I'm actually able to send an automatic Email without clicking "Yes" and without having to install anything "external" - But the problem is that it only work if I send an attachment for some strange reason. Is it not possible to use parts of the first VBA code example and add that into the second VBA example – in order to auto-send text instead of attachment? Is not the first VBA code above a "proof" that you don't need to install anything to actually bypass the pop up window?

Thanks,
 
Upvote 0
Ecksell,

the reason your first code sends the mail without you having to press anything is that you use the .display option (which just composes the email & doesnt send) you then have the line
Code: 
SendKeys "%{s}", True
which simulates you pressing the keyboard shortcut to send the email.

You should be able to change the .send to .display in your 2nd example & then use the sendkeys command to send the message.

This is only a workaround & not a truely automatic method of sending the message as it will not work if your computer is locked for example.
 
Upvote 0
You must log in or register to reply here.

Similar threads

G
  • Question
Email from Excel query
Replies
0
Views
208
gmazza76
G
C
  • Question
VBA - Email specific range and attach Sheet1
Replies
4
Views
583
Clermont
C
J
  • Question
Outlook Hypperlink of fila in email body will not open
Replies
1
Views
466
josros60
J
A
  • Question
Ron de Bruin VBA
Replies
2
Views
1K
Alexfoots
A
A
  • Solved
Sending hyperlink filepath via email
Replies
8
Views
437
AndyEd
A

Forum statistics

Threads
1,215,944
Messages
6,127,835
Members
449,411
Latest member
adunn_23

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top