Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Export only current sheet to email?
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 -- Regards, Sébastien Special Thanks in advance! Ben |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Export only current sheet to email?
Hi Ben
See this page for examples http://www.rondebruin.nl/sendmail.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ben in CA" wrote in message ... 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 -- Regards, Sébastien Special Thanks in advance! Ben |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Export only current sheet to email?
Thank you very much Ron - that gives me a great start!
"Ron de Bruin" wrote: Hi Ben See this page for examples http://www.rondebruin.nl/sendmail.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ben in CA" wrote in message ... 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 -- Regards, Sébastien Special Thanks in advance! Ben |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Export only current sheet to email?
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 |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Export only current sheet to email?
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 |
#6
Posted to microsoft.public.excel.programming
|
|||
|
|||
Export only current sheet to email?
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 |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
how do i export data to an email with excel | Excel Discussion (Misc queries) | |||
How do I export data from a workbook to an email | Excel Discussion (Misc queries) | |||
Email current page | Excel Discussion (Misc queries) | |||
macro - email current page | Excel Programming | |||
Lotus Notes/Export to email | Excel Programming |