How to Send Active Sheet as an Outlook Email Attachment with VBA

VBA Macro to Send Active Sheet as an Outlook Email Attachment from Active Workbook
The following Macro will copy the Active sheet data from the This/Active Workbook to a New Workbook with single sheet and Save that with Active sheet name, then it will send via Outlook as an Email Attachment, from a specified Email Account/Alias to the defined Users.
Sub Email_ActiveSheet_WB()
    Dim OutlookApp As Object
    Dim NewMail As Object
    Dim ActShtName As String
    Dim FileFullPath As String
       
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

'Copying the Active Sheet data
    ActiveSheet.Cells.Copy
    ActShtName = ActiveSheet.Name
  
  'Saving the Active sheet data  into a new workbook with Active Sheet name_Today date
    Workbooks.Add (xlWBATWorksheet)
    ActiveSheet.Paste
    Application.CutCopyMode = False
    ActiveSheet.Range("A1").Select
    ActiveSheet.Name = ActShtName

    Application.DisplayAlerts = False

    ActiveWorkbook.SaveAs Environ("UserProfile") & "\Desktop\Test\" & ActShtName & "_" &                                                                Format(Now, "dd-mmm-yyyy") & ".xlsx"

'Storing the Saved file(which we used for attachment later) path into a Variable
    FileFullPath = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name

    ActiveWorkbook.Close True

    Application.DisplayAlerts = True
  
'Setting up the objects of Outlook Application and New Email 
    Set OutlookApp = CreateObject("Outlook.Application")
    Set NewMail = OutlookApp.CreateItem(olMailItem)
    'Set NewMail = OutlookApp.CreateItem(0)

'Inserting Signature in Email Boday ; Change only 'YourSignature.htm' to the name of your Signature
    SigString = Environ("appdata") & "\Microsoft\Signatures\Tamatam.htm"

    If Dir(SigString) <> "" Then
        Signature = GetBoiler(SigString)
    Else
        Signature = ""
    End If

'Selecting your desired Email Account for Sending From Account
'If the account is not in your profile, Then you need to use SentOnBehalfOfName

        For I = 1 To OutlookApp.Session.Accounts.Count
          If OutlookApp.Session.Accounts.Item(I) = "MyEmailAccountAlias@Domain.Com"                   Then
        '--MsgBox OutlookApp.Session.Accounts.Item(I) & " : This is account number " & I
                Acn_No = I
                Exit For
           End If
        Next I

'Defining the Email Body Message
        Strbody = "<H3><B>TEST MAIL via EXCEL MACRO</B></H3>" & _
                    "This is Sample Test Email by Macro<br>" & _
                    "Please donot repond to It<br>" & _
                    "<A href=""https://excelkingdom.blogspot.in/"">Excel Kingdom</A>"
              
    On Error Resume Next

'Opening a New Email to Send

    With NewMail
        .TO = "YourEmail@Domain.com" 'Your Email Id here
        .CC = ""
        .BCC = ""
        .Subject = "Test Message" 'Your Email Subject here
       '.Body = "This Your Email Boday ; '--You can use below one as well
        .HTMLBody = Strbody & "<br>" & "<br>" & "<B>Thank you</B>" & "<br>" & Signature
        .Attachments.Add FileFullPath '-- Full Path of the Attachment where it is saved.
        .SentOnBehalfOfName = OutlookApp.Session.Accounts.Item(Acn_No) 
          '--You can use below one as well
        '.SentOnBehalfOfName = "MyEmailAccountAlias@Domain.Com"
        '.SendUsingAccount = OutlookApp.Session.Accounts.Item(Acn_No)
        .Display '--Use .Display to show you the Email before sending it.
        .Send
    End With
    
    On Error GoTo ErrMsg:    
' Since mail has been sent with the attachment.You can kill the Source file if not required    
    Kill FileFullPath
    
' Set nothing to the objects created.
    Set NewMail = Nothing
    Set OutlookApp = Nothing
    
' Now set the application properties back to true.
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
    MsgBox "Activesheet as Email Attchment Sent Successfully", vbOKOnly, "Job Done"
    Exit Sub

ErrMsg:
        MsgBox Err.Description

End Sub

'The Function to Look and Get the Email Signature; Calls into above Macro
   Function GetBoiler(ByVal SigFile As String) As String
      Dim FSO As Object
      Dim TS As Object
      Set FSO = CreateObject("Scripting.FileSystemObject")
      Set TS = FSO.GetFile(SigFile).OpenAsTextStream(1, -2)
      GetBoiler = TS.readall
      TS.Close

   End Function
---------------------------------------------------------------------------------------------------------------------
Note : Please note that You have to define both the Sub Procedure and Function in the same Module, to call Signature into your Email body.
---------------------------------------------------------------------------------------------------------------------

--------------------------------------------------------------------------------------------------------
Thanks, TAMATAM ; Business Intelligence & Analytics Professional
--------------------------------------------------------------------------------------------------------