Test this one then (you can add code to delete the button if you want)

Sub Mail_ActiveSheet()
'Working in 2000-2007
Dim FileExtStr As String
Dim FileFormatNum As Long
Dim Sourcewb As Workbook
Dim Destwb As Workbook
Dim TempFilePath As String
Dim TempFileName As String
Dim OutApp As Object
Dim OutMail As Object
Dim rng As Range

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

Set Sourcewb = ActiveWorkbook

'Copy the sheetinfo to a new workbook
Set rng = ActiveSheet.Cells
Set Destwb = Workbooks.Add(1)

rng.Copy Destwb.Sheets(1).Range("A1")
With Destwb.Sheets(1)
.Cells.Copy
.Cells.PasteSpecial xlPasteValues
.Cells(1).Select
End With
Application.CutCopyMode = False

On Error Resume Next
Destwb.Sheets(1).Name = rng.Parent.Name
On Error GoTo 0

If Val(Application.Version) < 12 Then
'You use Excel 2000-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"
TempFileName = "Part of " & Sourcewb.Name & " " _
& Format(Now, "dd-mmm-yy h-mm-ss")

Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr, _
FileFormat:=FileFormatNum
On Error Resume Next
With OutMail
.To = "
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = "Hi there"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send
End With
On Error GoTo 0
.Close SaveChanges:=False
End With

'Delete the file you have send
Kill TempFilePath & TempFileName & FileExtStr

Set OutMail = Nothing
Set OutApp = Nothing

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




--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




"andiam24" wrote in message ...

I completely forgot that pictures may be sent! How can the code be modified
to include the pics but delete the buttons? Thanks!