Home |
Search |
Today's Posts |
#1
![]()
Posted to microsoft.public.excel.programming
|
|||
|
|||
![]()
The following code works, but I need a slight adjustment....
I would like to ammend the following code to allow an prompt/message box that will ask me if I would like to insert a message in the body prior to sending the email. Sub Mail_ActiveSheet2() '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 = "Mouse 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("Mickey Mouse", "Minnie Mouse"), _ "Mouse Recap" 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr With Application .ScreenUpdating = True .EnableEvents = True End With End Sub |
Thread Tools | Search this Thread |
Display Modes | |
|
|
![]() |
||||
Thread | Forum | |||
Send a Sheet as body of Outlook Email | Excel Discussion (Misc queries) | |||
message in the body of the email | Excel Worksheet Functions | |||
Body message - email | Excel Programming | |||
Outlook email url in body | Excel Programming | |||
Late Binding to Outlook from Excel: Outlook modifies email body | Excel Programming |