Solved: Email a worksheet

[paulked]

Can anyone please help?

I am trying to send quotations by email direct from a worksheet without sending the whole workbook.

I have tried the routine below, but it comes up with the error "Run-time error '438' Object doesn't support this property or method"

Sub Email()
Dim EAdd, Def, Prom, Tit

Def = "paulked@o2.co.uk"
Prom = "Email Address?"
Tit = "Enter Email Recipient"

Application.ScreenUpdating = False

With Sheets("Email")
.PageSetup.PrintArea = "C2:J57"

If Range("F29").Value = 0 Then
.Rows("29").Hidden = True 'discount
.Rows("51:52").Hidden = True
End If

EAdd = InputBox(Prom, Tit, Def)

.SendMail Recipients:=EAdd
.Rows("29").Hidden = False
.Rows("51:52").Hidden = False
End With

ActiveWindow.View = xlNormalView
End Sub


I would appreciate any help whatsoever.

Many thanks

Paul

Edited 10-Apr-06 by GeekGirlau. Reason: put code in VBA tags

[johnske]

Hi paulked, welcome to VBAX.

Try this - Uses default email program to email active sheet with a message, deletes ws formulas, assumes the email addresses are on sheet1, A1 to A10 - modify to suit

Option Explicit

Sub EmailActiveSheetWithMessage()

Dim ThisDate As String, Recipient(1 To 10) As String, N As Long

ThisDate = Format(Date, "dd mmm yy")
For N = 1 To 10
'put your addies in Sheet1, A1:A10
Recipient(N) = Sheet1.Range("A" & N)
Next

Application.ScreenUpdating = False

ActiveSheet.Copy
With Cells
'get rid of formulas
.Copy
.PasteSpecial Paste:=xlPasteValues
End With

'Send the new workbook with a message
ActiveWorkbook.HasRoutingSlip = True
With ActiveWorkbook.RoutingSlip
.Recipients = Recipient()
.Subject = "Files for " & ThisDate
'insert your own text below
.Message = "Hi," & vbNewLine & _
"" & vbNewLine & _
"Attached files are for...blah blah..." & vbNewLine & _
"...more blah here.... " & vbNewLine & _
"" & vbNewLine & _
"Regards," & vbNewLine & _
"Your name" & vbNewLine & _
"" & vbNewLine & _
"" & vbNewLine & _
"" & vbNewLine & _
""
.Delivery = xlAllAtOnce
.ReturnWhenDone = False
End With

With ActiveWorkbook
.Route
.Saved = True
.Close False
End With
Application.ScreenUpdating = True

'Let user know what's happened
MsgBox "File sent by email ", , "Emailed..."
Sheet1.Activate

End Sub

[paulked]

Thanks for that, I'll give it a try although as we are sending quotations then the email address will be unknown until the request comes in.

Tanks again

[paulked]

A nice bit of coding.

I need to send the sheet as the body of an email rather than an attached file. The reasons are 1. Some people are blocked from receiving attachments and 2. If they update the information when opening the sheet they lose the data!

Any ideas?

Regards

Paul

[johnske]

Why not use use the built-in functionality? Go to View > Toolbars > Customize > Commands > File, then put the 'Send Now' command on one of your toolbars.

You then only need to click 'Send Now', type in the addy then click 'Send This Sheet'

[paulked]

That's exactly what I want to do, thanks. But, to make things "office-proof", I have disabled all menus. Can this be done in VB?

Appreciate your help, Best Regards

Paul

[paulked]

BTW,

This is the latest coding which sends out as an attached sheet:


Sub Email()
Dim EAdd, Def, Prom, Tit
Def = "paulked@o2.co.uk"
Prom = "Email Address?"
Tit = "Enter Email Recipient"
Application.ScreenUpdating = False
With Sheets("Email")
.PageSetup.PrintArea = "C2:J57"
If Range("F29").Value = 0 Then
.Rows("29").Hidden = True 'discount
.Rows("51:52").Hidden = True
End If
End With
EAdd = InputBox(Prom, Tit, Def)
With Sheets("EMail").Copy
End With
With ActiveWorkbook
.Sheets(1).Name = "quotation"
ActiveWorkbook.SendMail Recipients:=EAdd, Subject:="Quotation"
ActiveWorkbook.Close False
End With
With Sheets("EMail")
'.SendMail Recipients:=EAdd
.Rows("29").Hidden = False
.Rows("51:52").Hidden = False
End With
ActiveWindow.View = xlNormalView
End Sub

[Norie]

Paul

If you want the spreadsheet in the body of the email you'll need code that is specific to your email client. eg Outlook

Try a board search using the name of your email client.

[johnske]

I still think this is by far the easiest way for you to go...


Why not use use the built-in functionality? Go to View > Toolbars > Customize > Commands > File, then put the 'Send Now' command on one of your toolbars.

You then only need to click 'Send Now', type in the addy then click 'Send This Sheet'

This method requires you to use Outlook (which is OK if you use it as default, but not otherwise...), for more, go to http://www.rondebruin.nl/mail/folder3/mail2.htm
Option Explicit

Sub MailActiveSheetInBody()

'from: http://www.rondebruin.nl/mail/folder3/mail2.htm
Dim OutApp As Object
Dim OutMail As Object

Application.ScreenUpdating = False
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)

With OutMail
.To = "someone@somewhere.com"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = SheetToHTML(ActiveSheet)
.Send 'or use .Display
End With

Application.ScreenUpdating = True
Set OutMail = Nothing
Set OutApp = Nothing

End Sub

Public Function SheetToHTML(sh As Worksheet)

'Function from Dick Kusleika his site
'http://www.dicks-clicks.com/excel/sheettohtml.htm
'Changed by Ron de Bruin 04-Nov-2003

Dim TempFile As String
Dim Nwb As Workbook
Dim myshape As Shape
Dim fso As Object
Dim ts As Object

sh.Copy
Set Nwb = ActiveWorkbook

For Each myshape In Nwb.Sheets(1).Shapes
myshape.Delete
Next

TempFile = Environ$("temp") & "/" & _
Format(Now, "dd-mm-yy h-mm-ss") & ".htm"
Nwb.SaveAs TempFile, xlHtml
Nwb.Close False

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(TempFile).OpenAsTextStream(1, -2)

SheetToHTML = ts.ReadAll
ts.Close

Set ts = Nothing
Set fso = Nothing
Set Nwb = Nothing
Kill TempFile

End Function

[paulked]

Perfect :wizard: !

Thank you very much.

Best regards

Paul

[johnske]

So we can mark this solved?

[paulked]

I'd be happy to... If only I knew how!

Thanks again

[johnske]

That's temporarily out of action - I'll do it

[Norie]

Johnske

I totally forgot about RoutingSlip.:oops::doh: