View Single Post
  #2   Report Post  
Posted to microsoft.public.excel.programming
Damien McBain[_3_] Damien McBain[_3_] is offline
external usenet poster
 
Posts: 28
Default Preventing macros in attachment

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