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
This procedure will mail every
Worksheet with an address in cell A1. It does this by
cycling through
each worksheet in the workbook and checking cell A1 for the @ character.
If found, a copy of the worksheet is made and saved with a date/time stamp,
and then sent by e-mail to the address in cell A1. And finally, the file
is deleted from your hard disk
Note: if you use Windows
Live Mail the address must exist in your contacts.
Note:
Copy this macro in a standard module of the file with the sheets you want to
send.
Important: Read also the information below the
macro
Sub Mail_Every_Worksheet() 'For Tips see: https://jkp-ads.com/rdb/win/winmail/div/tips.htm 'Working in Excel 2000-2016 Dim sh As Worksheet Dim wb As Workbook Dim FileExtStr As String Dim FileFormatNum As Long Dim TempFilePath As String Dim TempFileName As String Dim I As Long TempFilePath = Environ$("temp") & "\" If Val(Application.Version) < 12 Then 'You use Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 Else 'You use Excel 2007-2016 FileExtStr = ".xlsm": FileFormatNum = 52 End If With Application .ScreenUpdating = False .EnableEvents = False End With For Each sh In ThisWorkbook.Worksheets If sh.Range("A1").Value Like "?*@?*.?*" Then sh.Copy Set wb = ActiveWorkbook TempFileName = "Sheet " & sh.Name & " of " _ & ThisWorkbook.Name & " " _ & Format(Now, "dd-mmm-yy h-mm-ss") With wb .SaveAs TempFilePath & TempFileName & FileExtStr, _ FileFormat:=FileFormatNum On Error Resume Next For I = 1 To 3 .SendMail sh.Range("A1").Value, _ "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 End If Next sh 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 xlsm
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