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 visible cells
in the
Range("A1:K50").The cells will be PasteSpecial as values in the
workbook you send.
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_Range() 'For Tips see: https://jkp-ads.com/rdb/win/winmail/div/tips.htm 'Working in Excel 2000-2016 Dim Source As Range Dim Dest As Workbook Dim wb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim FileExtStr As String Dim FileFormatNum As Long Dim I As Long Set Source = Nothing On Error Resume Next Set Source = Range("A1:K50").SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Source Is Nothing Then MsgBox "The source is not a range or the sheet is protected, " & _ "please correct and try again.", vbOKOnly Exit Sub End If With Application .ScreenUpdating = False .EnableEvents = False End With Set wb = ActiveWorkbook Set Dest = Workbooks.Add(xlWBATWorksheet) Source.Copy With Dest.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial Paste:=xlPasteValues .Cells(1).PasteSpecial Paste:=xlPasteFormats .Cells(1).Select Application.CutCopyMode = False End With TempFilePath = Environ$("temp") & "\" TempFileName = "Range of " & wb.Name & " " _ & Format(Now, "dd-mmm-yy h-mm-ss") If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007-2016 FileExtStr = ".xlsx": FileFormatNum = 51 End If With Dest .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
The following subroutine sends a newly
created workbook with just the visible cells
in the Selection.
The cells will be PasteSpecial as values in the workbook you send.
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 first macro on this page.
Sub Mail_Selection() 'For Tips see: https://jkp-ads.com/rdb/win/winmail/div/tips.htm 'Working in Excel 2000-2016 Dim Source As Range Dim Dest As Workbook Dim wb As Workbook Dim TempFilePath As String Dim TempFileName As String Dim FileExtStr As String Dim FileFormatNum As Long Dim I As Long Set Source = Nothing On Error Resume Next Set Source = Selection.SpecialCells(xlCellTypeVisible) On Error GoTo 0 If Source Is Nothing Then MsgBox "The source is not a range or the sheet is protected, " & _ "please correct and try again.", vbOKOnly Exit Sub End If If ActiveWindow.SelectedSheets.Count > 1 Or _ Selection.Cells.Count = 1 Or _ Selection.Areas.Count > 1 Then MsgBox "An Error occurred :" & vbNewLine & vbNewLine & _ "You have more than one sheet selected." & vbNewLine & _ "You only selected one cell." & vbNewLine & _ "You selected more than one area." & vbNewLine & vbNewLine & _ "Please correct and try again.", vbOKOnly Exit Sub End If With Application .ScreenUpdating = False .EnableEvents = False End With Set wb = ActiveWorkbook Set Dest = Workbooks.Add(xlWBATWorksheet) Source.Copy With Dest.Sheets(1) .Cells(1).PasteSpecial Paste:=8 .Cells(1).PasteSpecial Paste:=xlPasteValues .Cells(1).PasteSpecial Paste:=xlPasteFormats .Cells(1).Select Application.CutCopyMode = False End With TempFilePath = Environ$("temp") & "\" TempFileName = "Selection of " & wb.Name & " " _ & Format(Now, "dd-mmm-yy h-mm-ss") If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007-2016 FileExtStr = ".xlsx": FileFormatNum = 51 End If With Dest .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 save the new file as xlsx
But you can
change that if you want
Options for all Excel versions :
Save
the one sheet workbook to csv, txt or prn.
FileExtStr = ".csv": FileFormatNum = 6
FileExtStr = ".txt": FileFormatNum
= -4158
FileExtStr = ".prn": FileFormatNum = 36
Options
only for Excel 2007-2016 :
This are the main formats :
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)
FileExtStr = ".xlsb": FileFormatNum = 50
FileExtStr = ".xlsx": FileFormatNum = 51
FileExtStr = ".xlsm":
FileFormatNum = 52
FileExtStr = ".xls": FileFormatNum = 56