Export only current sheet to email?

[Ben in CA]

Hi,

I'd like a way that I can place a form button on a worksheet in Excel, that
when pressed, just exports the current sheet to a new Excel file, (preferably
with a message prompt to give it a file name - .xls added automatically),
saves it to the desktop, and then automatically attaches it to a new email in
Outlook. (Similar to Send to mail recipient as attachment, except only with
that sheet in the work book.)

Does anyone know if this is possible with macros? I would expect many people
would find it useful.

Any replies are appreciated!

Here's some code I found in the community that might be able to be modified.
(It's supposed to export the sheet into a different existing file.)

section 'Change Here'):
Sub Macro2()

Dim wshO As Worksheet, nameO As String 'Origin sheet
Dim wshD As Worksheet, WbkD As Workbook, nameD As String 'Destination
variables
Dim count As Long


' Set variables
'------ CHANGE HERE ------------
Set wshO = ActiveSheet
Set WbkD = Workbooks(2)
'-------------------------------
nameO = wshO.Name
count = WbkD.Sheets.count

'Get name from user
nameD = Application.InputBox("Enter new name", "New Sheet Name")
If nameD = "False" Then Exit Sub 'Cancelled by user

'Copy sheet
wshO.Copy After:=Workbooks(2).Sheets(count)
Set wshD = WbkD.Sheets(count + 1) 'new sheet is last one

'Rename
On Error Resume Next
wshD.Name = nameD
If Err <> 0 Then
MsgBox "The provided name '" & nameD & "' is not valie (invalid or
already exist)" & _
vbNewLine & "Please, set it manually."
End If
End Sub
[/QUOTE][/QUOTE][/QUOTE]

Special Thanks in advance!

Ben

 

[Ron de Bruin]

Hi Ben

See this page for examples
http://www.rondebruin.nl/sendmail.htm

--

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

Hi,

I'd like a way that I can place a form button on a worksheet in Excel, that
when pressed, just exports the current sheet to a new Excel file, (preferably
with a message prompt to give it a file name - .xls added automatically),
saves it to the desktop, and then automatically attaches it to a new email in
Outlook. (Similar to Send to mail recipient as attachment, except only with
that sheet in the work book.)

Does anyone know if this is possible with macros? I would expect many people
would find it useful.

Any replies are appreciated!

Here's some code I found in the community that might be able to be modified.
(It's supposed to export the sheet into a different existing file.)

section 'Change Here'):
Sub Macro2()

Dim wshO As Worksheet, nameO As String 'Origin sheet
Dim wshD As Worksheet, WbkD As Workbook, nameD As String 'Destination
variables
Dim count As Long


' Set variables
'------ CHANGE HERE ------------
Set wshO = ActiveSheet
Set WbkD = Workbooks(2)
'-------------------------------
nameO = wshO.Name
count = WbkD.Sheets.count

'Get name from user
nameD = Application.InputBox("Enter new name", "New Sheet Name")
If nameD = "False" Then Exit Sub 'Cancelled by user

'Copy sheet
wshO.Copy After:=Workbooks(2).Sheets(count)
Set wshD = WbkD.Sheets(count + 1) 'new sheet is last one

'Rename
On Error Resume Next
wshD.Name = nameD
If Err <> 0 Then
MsgBox "The provided name '" & nameD & "' is not valie (invalid or
already exist)" & _
vbNewLine & "Please, set it manually."
End If
End Sub

[/QUOTE]

Special Thanks in advance!

Ben[/QUOTE]

 

[Ben in CA]

Thank you very much Ron - that gives me a great start!

Hi Ben

See this page for examples
http://www.rondebruin.nl/sendmail.htm

--

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




Special Thanks in advance!

Ben

[/QUOTE]

 

[Ben in CA]

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 = "(e-mail address removed)"
.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

 

[Ron de Bruin]

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 = "(e-mail address removed)"
.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

 

[Ben in CA]

Perfect! Thanks a lot Ron!

Ben

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 = "(e-mail address removed)"
.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