Difficulties sending worksheet through email via SendWorksheet button - vba

Question

I have an Excel 2016 worksheet with a "Send Worksheet" button purposed to email the worksheet to all the designated recipients. When I run the following code (most of which came from another program and tweaked), I receive the following errors:
Runtime Error 429: ActiveX component can't create object.
at Set OutlookApp = CreateObject("Outlook.Application")
as well as
Runtime Error 91: Object variable or With block variable not set.
in the With block at .To = "email address".
Option Explicit
Private Sub cmdSendWorksheet_Click()
Dim xFile As String
Dim xFormat As Long
Dim Wb As Workbook
Dim Wb2 As Workbook
Dim FilePath As String
Dim FileName As String
Dim OutlookApp As Object
Dim OutlookMail As Object
'On Error Resume Next
Application.ScreenUpdating = False
Set Wb = Application.ActiveWorkbook
ActiveSheet.Copy
Set Wb2 = Application.ActiveWorkbook
Select Case Wb.FileFormat
Case xlOpenXMLWorkbook:
xFile = ".xlsx"
xFormat = xlOpenXMLWorkbook
Case xlOpenXMLWorkbookMacroEnabled:
If Wb2.HasVBProject Then
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbookMacroEnabled
Else
xFile = ".xlsm"
xFormat = xlOpenXMLWorkbook
End If
End Select
FilePath = Environ$("temp") & "\"
FileName = Wb.Name & Format(Now, "dd-mmm-yy h-mm-ss")
Set OutlookApp = CreateObject("Outlook.Application")
Set OutlookMail = OutlookApp.CreateItem(0)
Wb2.SaveAs FilePath & FileName & xFile, FileFormat:=xFormat
With OutlookMail
.To = "email address"
.CC = ""
.BCC = ""
.Subject = "Worksheet Attached"
.Body = "Please see attached worksheet"
.cmdSendWorksheet.Enabled = True
.Attachments.Add Wb2.FullName
.Send
End With
Wb2.Close
Kill FilePath & FileName & xFile
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Application.ScreenUpdating = True
End Sub

Answer 1

this code should do the job you need. But you need to go in Tools / References and check the following reference :
Microsoft Scripting Runtime
Microsoft Outlook 14.0 Object Library
Private Sub cmdSendWorksheet_Click()
Dim Wb As Workbook
Dim FilePath As String
Dim FileName As String
Dim FileExtensionName As String
Dim FileFullPath As String
Dim OutlookApp As New Outlook.Application
Dim OutlookMail As Outlook.MailItem
Dim fso As New FileSystemObject
'On Error Resume Next
Application.ScreenUpdating = False
Set Wb = ThisWorkbook
FilePath = Environ$("temp") & "\"
FileName = fso.GetBaseName(Wb.Path & "\" & Wb.Name) & Format(Now, "dd-mmm-yy h-mm-ss")
FileExtensionName = fso.GetExtensionName(Wb.Path & "\" & Wb.Name)
FileFullPath = FilePath & FileName & "." & FileExtensionName
fso.CopyFile Wb.Path & "\" & Wb.Name, FileFullPath
'Sending the email
Set OutlookMail = OutlookApp.CreateItem(olMailItem)
With OutlookMail
.To = "email address"
.CC = ""
.BCC = ""
.Subject = "Worksheet Attached"
.Body = "Please see attached worksheet"
.Attachments.Add FileFullPath
.Display
'.Send You can chose .Send or .Display, as you wish
End With
Kill FileFullPath
'Free the memory
Set OutlookMail = Nothing
Set OutlookApp = Nothing
Set fso = Nothing
Application.ScreenUpdating = True
Application.Quit
End Sub