 Back to jkp-ads.com |
Ron de Bruin
|
 |
|
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 ActiveSheet.
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_ActiveSheet() '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 I As Long 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-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 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 = "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
You can also use the following line if you know the name of the sheet you
want to mail :
Sheets("Sheet5").Copy
It
doesn't have to be the active sheet used at that time.
Information
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
Or maye you want to save the one sheet workbook to csv, txt ot prn.
(you can use this also if you run it in 97-2003)
FileExtStr = ".csv": FileFormatNum = 6
FileExtStr =
".txt": FileFormatNum = -4158
FileExtStr = ".prn": FileFormatNum = 36
The example below will send each sheet
in the Shname Array to a person In the Addr Array.
In this example four
separate mails will be send with one sheet.
Note: if you use Windows Live
Mail the address must exist in your contacts.
Sheet1 to ron@test.nl
Sheet2 to jelle@test.nl
Sheet3 to judith@test.nl
Sheet4 to
nicolet@test.nl
If you run the macro in Excel 2007-2016 the files
will be saved/send as xlsm files.
You can change that to another format
if you want (See information of Example 1)
Copy this macro in a module of
the file with the sheets in the array, not in your personal.xls(b).
Sub Mail_Sheets() 'For Tips see: https://jkp-ads.com/rdb/win/winmail/div/tips.htm 'Working in Excel 2000-2016 Dim wb As Workbook Dim Shname As Variant Dim Addr As Variant Dim N As Integer Dim TempFilePath As String Dim TempFileName As String Dim FileExtStr As String Dim FileFormatNum As Long Dim I As Long Shname = Array("Sheet1", "Sheet2", "Sheet3", "Sheet4") Addr = Array("ron@test.nl", "jelle@test.nl", "judith@test.nl", "nicolet@test.nl") If Val(Application.Version) >= 12 Then 'You run Excel 2007-2016 FileExtStr = ".xlsm": FileFormatNum = 52 Else 'You run Excel 97-2003 FileExtStr = ".xls": FileFormatNum = -4143 End If With Application .ScreenUpdating = False .EnableEvents = False End With TempFilePath = Environ$("temp") & "\" 'Create the new workbooks/Mail it/Delete it For N = LBound(Shname) To UBound(Shname) TempFileName = "Sheet " & Shname(N) & " " & Format(Now, "dd-mmm-yy h-mm-ss") ThisWorkbook.Sheets(Shname(N)).Copy Set wb = ActiveWorkbook With wb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormatNum On Error Resume Next For I = 1 To 3 .SendMail Addr(N), _ "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 Next N With Application .ScreenUpdating = True .EnableEvents = True End With End Sub