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
Important read this :
The code on this page is only working when you use Outlook as your mail
program.
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.
Important: Read also the information below the macro
Sub Mail_ActiveSheet() 'Working in Excel 2000-2016 'For Tips see: https://jkp-ads.com/rdb/win/winmail/Outlook/tips.htm 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 OutApp As Object Dim OutMail As Object With Application .ScreenUpdating = False .EnableEvents = False End With Set Sourcewb = ActiveWorkbook 'Copy the ActiveSheet 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") Set OutApp = CreateObject("Outlook.Application") Set OutMail = OutApp.CreateItem(0) With Destwb .SaveAs TempFilePath & TempFileName & FileExtStr, FileFormat:=FileFormatNum On Error Resume Next With OutMail .to = "ron@debruin.nl" .CC = "" .BCC = "" .Subject = "This is the Subject line" .Body = "Hi there" .Attachments.Add Destwb.FullName 'You can add other files also like this '.Attachments.Add ("C:\test.txt") .Send 'or use .Display End With On Error GoTo 0 .Close savechanges:=False End With 'Delete the file you have send Kill TempFilePath & TempFileName & FileExtStr Set OutMail = Nothing Set OutApp = Nothing 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.
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
If you want to use the Intellisense help showing you the properties and
methods of the objects as you
type you can use Early Binding.
Bit faster also when you run your code but you can have problems when you
distribute your workbooks. Excel will automatic update the reference number
to Outlook when you open your workbook in a higher version of Excel/Outlook
but not update it when you open it in a lower version of Excel/Outlook. With
Late Binding as I used in the macro examples you not have
this problem.
Add a reference to the Microsoft Outlook Library in
Excel
1) Go to the VBA editor with the shortcut
Alt - F11
2) Click on
Tools>References in the Menu bar
3) Place a
Checkmark before Microsoft Outlook ? Object Library
Where ? is the Outlook version number
Then replace
this three lines in the code
Dim OutApp As
Object
Dim OutMail As Object
Set OutMail = OutApp.CreateItem(0)
With this three lines
Dim OutApp As
Outlook.Application
Dim OutMail As Outlook.MailItem
Set OutMail =
OutApp.CreateItem(olMailItem)