| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
save worksheet then email the saved worksheet
Hi, what I'm looking for is a macro that will save a worksheet as a new
workbook with whatever customer name in a cell in this said worksheet and then email the new workbook, all by on click. I'm trying to keep this sheet as dummy proof as possible. Thanks |
|
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
save worksheet then email the saved worksheet
hi Sly101
See http://www.rondebruin.nl/sendmail.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sly101" wrote in message ... Hi, what I'm looking for is a macro that will save a worksheet as a new workbook with whatever customer name in a cell in this said worksheet and then email the new workbook, all by on click. I'm trying to keep this sheet as dummy proof as possible. Thanks |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
save worksheet then email the saved worksheet
thanks for the quick reply, I have tried this one, I am using this example
but would like save as with specific content of a cell then send via email the new workbook. 'Working in 97-2007 Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim sh As Worksheet Dim DateString As String Dim FolderName As String With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With 'Copy every sheet from the workbook with this macro Set Sourcewb = ThisWorkbook 'Create new folder to save the new files in DateString = Format(Now, "yyyy-mm-dd hh-mm-ss") FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString MkDir FolderName 'Copy every visible sheet to a new workbook For Each sh In Sourcewb.Worksheets 'If the sheet is visible then copy it to a new workbook If sh.Visible = -1 Then sh.Copy 'Set Destwb to the new workbook 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 If Sourcewb.Name = .Name Then MsgBox "Your answer is NO in the security dialog" GoTo GoToNextSheet 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 If Destwb.Sheets(1).ProtectContents = False Then With Destwb.Sheets(1).UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False End If 'Save the new workbook and close it With Destwb .SaveAs FolderName _ & "\" & Destwb.Sheets(1).Name & FileExtStr, _ FileFormat:=FileFormatNum .Close False End With End If GoToNextSheet: Next sh MsgBox "You can find the files in " & FolderName With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With End Sub "Ron de Bruin" wrote: hi Sly101 See http://www.rondebruin.nl/sendmail.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sly101" wrote in message ... Hi, what I'm looking for is a macro that will save a worksheet as a new workbook with whatever customer name in a cell in this said worksheet and then email the new workbook, all by on click. I'm trying to keep this sheet as dummy proof as possible. Thanks |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
save worksheet then email the saved worksheet
If you want to mail you can do it in one step
http://www.rondebruin.nl/mail/folder1/mail5.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sly101" wrote in message ... thanks for the quick reply, I have tried this one, I am using this example but would like save as with specific content of a cell then send via email the new workbook. 'Working in 97-2007 Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim sh As Worksheet Dim DateString As String Dim FolderName As String With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With 'Copy every sheet from the workbook with this macro Set Sourcewb = ThisWorkbook 'Create new folder to save the new files in DateString = Format(Now, "yyyy-mm-dd hh-mm-ss") FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString MkDir FolderName 'Copy every visible sheet to a new workbook For Each sh In Sourcewb.Worksheets 'If the sheet is visible then copy it to a new workbook If sh.Visible = -1 Then sh.Copy 'Set Destwb to the new workbook 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 If Sourcewb.Name = .Name Then MsgBox "Your answer is NO in the security dialog" GoTo GoToNextSheet 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 If Destwb.Sheets(1).ProtectContents = False Then With Destwb.Sheets(1).UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False End If 'Save the new workbook and close it With Destwb .SaveAs FolderName _ & "\" & Destwb.Sheets(1).Name & FileExtStr, _ FileFormat:=FileFormatNum .Close False End With End If GoToNextSheet: Next sh MsgBox "You can find the files in " & FolderName With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With End Sub "Ron de Bruin" wrote: hi Sly101 See http://www.rondebruin.nl/sendmail.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sly101" wrote in message ... Hi, what I'm looking for is a macro that will save a worksheet as a new workbook with whatever customer name in a cell in this said worksheet and then email the new workbook, all by on click. I'm trying to keep this sheet as dummy proof as possible. Thanks |
|
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
save worksheet then email the saved worksheet
Look also at the mail templates
http://www.rondebruin.nl/mail/templates.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Ron de Bruin" wrote in message ... If you want to mail you can do it in one step http://www.rondebruin.nl/mail/folder1/mail5.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sly101" wrote in message ... thanks for the quick reply, I have tried this one, I am using this example but would like save as with specific content of a cell then send via email the new workbook. 'Working in 97-2007 Dim FileExtStr As String Dim FileFormatNum As Long Dim Sourcewb As Workbook Dim Destwb As Workbook Dim sh As Worksheet Dim DateString As String Dim FolderName As String With Application .ScreenUpdating = False .EnableEvents = False .Calculation = xlCalculationManual End With 'Copy every sheet from the workbook with this macro Set Sourcewb = ThisWorkbook 'Create new folder to save the new files in DateString = Format(Now, "yyyy-mm-dd hh-mm-ss") FolderName = Sourcewb.Path & "\" & Sourcewb.Name & " " & DateString MkDir FolderName 'Copy every visible sheet to a new workbook For Each sh In Sourcewb.Worksheets 'If the sheet is visible then copy it to a new workbook If sh.Visible = -1 Then sh.Copy 'Set Destwb to the new workbook 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 If Sourcewb.Name = .Name Then MsgBox "Your answer is NO in the security dialog" GoTo GoToNextSheet 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 If Destwb.Sheets(1).ProtectContents = False Then With Destwb.Sheets(1).UsedRange .Cells.Copy .Cells.PasteSpecial xlPasteValues .Cells(1).Select End With Application.CutCopyMode = False End If 'Save the new workbook and close it With Destwb .SaveAs FolderName _ & "\" & Destwb.Sheets(1).Name & FileExtStr, _ FileFormat:=FileFormatNum .Close False End With End If GoToNextSheet: Next sh MsgBox "You can find the files in " & FolderName With Application .ScreenUpdating = True .EnableEvents = True .Calculation = xlCalculationAutomatic End With End Sub "Ron de Bruin" wrote: hi Sly101 See http://www.rondebruin.nl/sendmail.htm -- Regards Ron de Bruin http://www.rondebruin.nl/tips.htm "Sly101" wrote in message ... Hi, what I'm looking for is a macro that will save a worksheet as a new workbook with whatever customer name in a cell in this said worksheet and then email the new workbook, all by on click. I'm trying to keep this sheet as dummy proof as possible. Thanks |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| Email one worksheet to email address on worksheet | Excel Worksheet Functions | |||
| Email worksheet from named list on another worksheet | Excel Programming | |||
| Have saved over excel worksheet - how to revert to old worksheet? | New Users to Excel | |||
| 'Save current worksheet'; 'Open next worksheet' - two command buttons | Excel Discussion (Misc queries) | |||
| Can't save Excell worksheet from email | Excel Discussion (Misc queries) | |||
Linear Mode
