I have had some success doing the same thing by copying the sheet/s I want
to email into a new workbook and e-mailing that new workbook. The code you
quoted doesn't seem to be creating a new workbook, just replacing all the
formulas with values then e-mailing the whole thing.
Here's what I've used to create the new workbook:
==========================
Sub CreateSalesFile()
ActiveSheet.Range("statustext") = "Creating Sales File"
' make sure the user has entered required info
If Range("date") = "" Then
NoDate
Exit Sub
Else
End If
' make it so the user can't see the routing running
Application.ScreenUpdating = False
'select the sheet I want then copy it to a new book
Sheets("Sales").Select
Sheets("Sales").Copy
Workbooks(Workbooks.Count).Activate
ActiveSheet.Unprotect
'overwrite all the formulas with values
Cells.Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Application.CutCopyMode = False
Range("A1").Select
' save the new book
ChDir "I:\department\Accounting\Daily Tonnes\DailyReports"
ActiveWorkbook.SaveAs Filename:= _
"I:\department\Accounting\Daily Tonnes\DailyReports\" &
Range("Date") & "-Sales.xls"
'restore the environment and provide feedback
ActiveWindow.Close
'MsgBox "File: I:\department\Accouting\Daily Tonnes\DailyReports\" &
Range("Date") & "-Sales.xls has been created", , "Daily Tonnes"
Workbooks("Daily Tonnes Model.xls").Activate
Sheets("Main").Activate
'Range("E28") = "Done"
Range("Date").Select
Application.ScreenUpdating = True
ActiveSheet.Range("statustext") = "Sales File " & Range("Date") &
"-Sales.xls Created"
End Sub
=======================
To e-mail it, I use Outlook Redemption (
http://www.dimastr.com/redemption/)
to avoid all the silly questions that Outlook asks every time you want to
send an e-mail with code from excel.
=======================
Sub EmailOutSales()
On Error GoTo OhFark
Dim SafeItem As Object
'dim oitem as
Set SafeItem = CreateObject("Redemption.SafeMailItem")
Set oItem = Outlook.CreateItem(0)
SafeItem.Item = oItem
'adds recipients from a list of recipients on a worksheet
For Each c In Range("emailsales")
If c.Text < "" Then
SafeItem.Recipients.Add c.Text
Else
Exit For
End If
Next c
SafeItem.Recipients.ResolveAll
SafeItem.Subject = "Haulage for " & Range("date")
SafeItem.Attachments.Add ("I:\department\Accounting\Daily
Tonnes\DailyReports\" & Range("date") & "-sales.xls")
SafeItem.Send
Set SafeItem = Nothing
Set oItem = Nothing
gtfo:
Exit Sub
OhFark:
MsgBox "You need to have a program called Outlook Redemption installed for
this to work" & Chr(13) & _
"Outlook redemption is a nice little
VB add in which gets around the
sendmail macro protection in Outlook" _
, , "Daily Tonnes"
Resume gtfo
End Sub