Back to jkp-ads.com |
Ron de Bruin
|
Ron de Bruin decided to remove all Windows Excel content from his website for personal reasons. If you want to know why, head over to rondebruin.nl.
Luckily, Ron was kind enough to allow me to publish all of his Excel content here.
Most of these pages are slightly outdated and may contain links that don 't work. Please inform me if you find such an error and I'll try to fix it.
Kind regards
Jan Karel Pieterse
The code on this page is working with all Microsoft mail programs.
Note: With SendMail it is not possible to
1) Send text in the Body of the mail
2) Use
the CC or BCC field
3) Attach other files
If you
want to have the options above and more and use Microsoft Outlook as your
mail program then use the Outlook object
model examples from my site so you have much more control and options.
Copy the code in a Standard module of your workbook, if you just
started with VBA see this page.
Where do I paste
the code that I find on the internet
Check out this Tip page for changing the code on this page.
Tips for changing the code examples
The following subroutine sends a newly
created workbook with just the sheets in the Array.
.Sheets(Array("Sheet1", "Sheet3")).Copy
Use this if you want to send the selected sheets
TheActiveWindow.SelectedSheets.Copy
It
is saving the workbook before mailing it with a date/time stamp.
After
the file is sent the workbook will be deleted from your hard disk.
Change the mail address and subject in the macro before you run it.
Note: if you use Windows Live Mail the address must exist
in your contacts.
If you change "ron@debruin.nl" to
"" it will display the mail so you can add text in the body
for example.
Important: Read also the information
below the macro
Sub Mail_Sheets_Array() 'For Tips see: https://jkp-ads.com/rdb/win/winmail/div/tips.htm 'Working in Excel 2000-2016 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 sh As Worksheet Dim TheActiveWindow As Window Dim TempWindow As Window Dim I As Long With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the sheets to a new workbook 'We add a temporary Window to avoid the Copy problem 'if there is a List or Table in one of the sheets and 'if the sheets are grouped With Sourcewb Set TheActiveWindow = ActiveWindow Set TempWindow = .NewWindow .Sheets(Array("Sheet1", "Sheet3")).Copy End With 'Close temporary Window TempWindow.Close 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-2016 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 With ' 'Change all cells in the worksheets to values if you want ' For Each sh In Destwb.Worksheets ' sh.Select ' With sh.UsedRange ' .Cells.Copy ' .Cells.PasteSpecial xlPasteValues ' .Cells(1).Select ' End With ' Application.CutCopyMode = False ' Destwb.Worksheets(1).Select ' Next sh 'Save the new workbook/Mail it/Delete it TempFilePath = Environ$("temp") & "\" TempFileName = "Part of " & Sourcewb.Name _ & " " & Format(Now, "dd-mmm-yy h-mm-ss") With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum On Error Resume Next For I = 1 To 3 .SendMail "ron@debruin.nl", _ "This is the Subject line" If Err.Number = 0 Then Exit For Next I On Error GoTo 0 .Close SaveChanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr With Application .ScreenUpdating = True .EnableEvents = True End With End Sub
In the macro you see that if
Val(Application.Version) < 12 is True that I
use
FileExtStr = ".xls": FileFormatNum = -4143
This is the normal Excel workbook format in 97-2003
If you run the
code in Excel 2007-2016 it will look at the FileFormat of the parent
workbook and save the new file in that format. Only if the parent
workbook is an xlsm file and if there is no code in the new workbook it will
save the new file as xlsx, this way the receiver knows that this is a macro
free file.
If the parent workbook is not an xlsx, xlsm, or xls then it
will be saved as xlsb.
This are the main formats in Excel 2007-2016 :
51 = xlOpenXMLWorkbook (without macro's in 2007-2016,
xlsx)
52 = xlOpenXMLWorkbookMacroEnabled (with or
without macro's in 2007-2016, xlsm)
50 = xlExcel12
(Excel Binary Workbook in 2007-2016 with or without macro’s, xlsb)
56 = xlExcel8 (97-2003 format in Excel 2007-2016, xls)
If you always want to save in a certain format you can replace this part
of the macro
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
With one of the one liners from this list
FileExtStr = ".xlsb": FileFormatNum = 50
FileExtStr = ".xlsx":
FileFormatNum = 51
FileExtStr = ".xlsm": FileFormatNum = 52
FileExtStr
= ".xls": FileFormatNum = 56