I have mail this active sheet code that works just fine... I only need
to make two small ammendments.

- Instead of the subject being pre-set (in the code below), I need a
pop-up box asking for the title. (This is the line where the title "My
Daily Performance" is just after the email names).

- I also need a pop-up box asking for any comments in the body of the
email.

Thanx


Sub Mail_ActiveSheet()
'Working in 97-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

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

Set Sourcewb = ActiveWorkbook

'Copy the sheet to a new workbook
ActiveSheet.Copy
Set Destwb = ActiveWorkbook

'Determine the Excel version and file extension/format
With Destwb
If Val(Application.Version) < 12 Then
'You use Excel 97-2003
FileExtStr = ".xls": FileFormatNum = -4143
Else
'You use Excel 2007
'We exit the sub when your answer is NO in the security
dialog that you only
'see when you copy a sheet from a xlsm file with macro's
disabled.
If Sourcewb.Name = .Name Then
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
MsgBox "Your answer is NO in the security dialog"
Exit Sub
Else
Select Case Sourcewb.FileFormat
Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
Case 52:
If .HasVBProject Then
FileExtStr = ".xlsm": FileFormatNum = 52
Else
FileExtStr = ".xlsx": FileFormatNum = 51
End If
Case 56: FileExtStr = ".xls": FileFormatNum = 56
Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
End Select
End If
End If
End With

' 'Change all cells in the worksheet to values if you want
' With Destwb.Sheets(1).UsedRange
' .Cells.Copy
' .Cells.PasteSpecial xlPasteValues
' .Cells(1).Select
' End With
' Application.CutCopyMode = False

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

With Destwb
.SaveAs TempFilePath & TempFileName & FileExtStr,
FileFormat:=FileFormatNum
On Error Resume Next

.SendMail Array("Jeremy Aldridge", "Mickey Mouse"),
_
"My Daily Performance"


On Error GoTo 0
.Close SaveChanges:=False
End With

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

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

Which mail program do you use ?


--

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


"J.W. Aldridge" <(E-Mail Removed)> wrote in message
news:1d185ac9-b6b9-4b15-94af-(E-Mail Removed)...
>I have mail this active sheet code that works just fine... I only need
> to make two small ammendments.
>
> - Instead of the subject being pre-set (in the code below), I need a
> pop-up box asking for the title. (This is the line where the title "My
> Daily Performance" is just after the email names).
>
> - I also need a pop-up box asking for any comments in the body of the
> email.
>
> Thanx
>
>
> Sub Mail_ActiveSheet()
> 'Working in 97-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
>
> With Application
> .ScreenUpdating = False
> .EnableEvents = False
> End With
>
> Set Sourcewb = ActiveWorkbook
>
> 'Copy the sheet to a new workbook
> ActiveSheet.Copy
> Set Destwb = ActiveWorkbook
>
> 'Determine the Excel version and file extension/format
> With Destwb
> If Val(Application.Version) < 12 Then
> 'You use Excel 97-2003
> FileExtStr = ".xls": FileFormatNum = -4143
> Else
> 'You use Excel 2007
> 'We exit the sub when your answer is NO in the security
> dialog that you only
> 'see when you copy a sheet from a xlsm file with macro's
> disabled.
> If Sourcewb.Name = .Name Then
> With Application
> .ScreenUpdating = True
> .EnableEvents = True
> End With
> MsgBox "Your answer is NO in the security dialog"
> Exit Sub
> Else
> Select Case Sourcewb.FileFormat
> Case 51: FileExtStr = ".xlsx": FileFormatNum = 51
> Case 52:
> If .HasVBProject Then
> FileExtStr = ".xlsm": FileFormatNum = 52
> Else
> FileExtStr = ".xlsx": FileFormatNum = 51
> End If
> Case 56: FileExtStr = ".xls": FileFormatNum = 56
> Case Else: FileExtStr = ".xlsb": FileFormatNum = 50
> End Select
> End If
> End If
> End With
>
> ' 'Change all cells in the worksheet to values if you want
> ' With Destwb.Sheets(1).UsedRange
> ' .Cells.Copy
> ' .Cells.PasteSpecial xlPasteValues
> ' .Cells(1).Select
> ' End With
> ' Application.CutCopyMode = False
>
> 'Save the new workbook/Mail it/Delete it
> TempFilePath = Environ$("temp") & "\"
> TempFileName = "My Daily Recap"
> 'TempFileName = Sourcewb.Name & " " & Format(Now, "dd-mmm-yy h-mm-
> ss")
>
> With Destwb
> .SaveAs TempFilePath & TempFileName & FileExtStr,
> FileFormat:=FileFormatNum
> On Error Resume Next
>
> .SendMail Array("Jeremy Aldridge", "Mickey Mouse"),
> _
> "My Daily Performance"
>
>
> On Error GoTo 0
> .Close SaveChanges:=False
> End With
>
> 'Delete the file you have send
> Kill TempFilePath & TempFileName & FileExtStr
>
> With Application
> .ScreenUpdating = True
> .EnableEvents = True
> End With
> End Sub
>

I use outlook, 2003

>I use outlook, 2003

Then use code like this and use
http://www.rondebruin.nl/mail/folder2/mail2.htm

..Display instead of .Send



--

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


"J.W. Aldridge" <(E-Mail Removed)> wrote in message
news:2e312777-0d10-4e25-8c5b-(E-Mail Removed)...
>I use outlook, 2003