About Us

Ben in CA[_2_]

Perfect! Thanks a lot Ron!

Ben

"Ron de Bruin" wrote:

Test this one

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 myValue As String
Dim WshShell As Object
Dim SpecialPath 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 2000-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
FileExtStr = ".xls": FileFormatNum = 56
End If
End If
End With

Set WshShell = CreateObject("WScript.Shell")
SpecialPath = WshShell.SpecialFolders("Desktop")

'Save the new workbook/Mail it/Delete it
TempFilePath = SpecialPath & "\"

'Get name from user
myValue = Application.InputBox(prompt:="Please name this...", Type:=2)
If myValue = "" Then myValue = "Untitled"

TempFileName = "Results" & myValue & Format(Now, "mmm-dd-yy h-mm")

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 = "Results - "
.Body = "See attached"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send to send now
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

"Ben in CA" wrote in message ...
Now, I've got part of this figured out, but I'd like to get some bugs worked
out.
(I had it working, but wanted to add some more functionality.)

Currently, I get an error after I enter the value I want the filename called.

Also, I want to have it save the file directly to the user's desktop before
it emails it - rather than a temp file. (with a relative path to the desktop
if possible - several users, and the file will be frequently updated by one
user and sent to the others - so I can't have the macro changing. Otherwise,
just to C:\results)

(And I'll remove the line that deletes the temporary file.)

Anyone have any ideas? Thanks!

Here's my code:

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

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 2000-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
FileExtStr = ".xls": FileFormatNum = 56
End If
End If
End With

'Save the new workbook/Mail it/Delete it
TempFilePath = Environ$("temp") & "\"

'Get name from user
Dim message, title, defaultValue As String
Dim myValue As Object
' Set prompt message and title
message = "Please enter a file name. Date and time will be added
automatically."
title = "Please name this..."
' Display input
myValue = InputBox(message, title, defaultValue)
' If user has clicked Cancel, set myValue to Untitled
If myValue Is Empty Then myValue = "Untitled"

TempFileName = "Resutls" & myValue & Format(Now, "mmm-dd-yy h:mm")

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 = "Results - "
.Body = "See attached"
.Attachments.Add Destwb.FullName
'You can add other files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Send to send now
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

Thanks,

Ben

Thread Tools	Search this Thread
Show Printable Version	Search this Thread: Advanced Search
Display Modes
Switch to Linear Mode Switch to Hybrid Mode Threaded Mode

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
how do i export data to an email with excel	A Rutherford[_2_]	Excel Discussion (Misc queries)	1	May 19th 09 08:26 PM
How do I export data from a workbook to an email	A Rutherford	Excel Discussion (Misc queries)	1	May 19th 09 07:22 PM
Email current page	Mike	Excel Discussion (Misc queries)	4	October 5th 08 05:49 PM
macro - email current page	Mack Neff[_2_]	Excel Programming	0	June 6th 07 02:17 AM
Lotus Notes/Export to email	na	Excel Programming	1	November 16th 04 09:14 PM

Menu

About Us