In previous article of Send Email Tutorial using Excel Macro, you learnt how to send current workbook as attachment in the email.
In this Article you are going to learn how to send the ActiveSheet as an attachment in Email. The below function sends the active sheet as an attachment in email.



Sub Email_One_ActiveSheet()

    'Do not forget to change the email ID
    'before running this code
    
    Dim OlApp As Object
    Dim NewMail As Object
    Dim TempFilePath As String
    Dim FileExt As String
    Dim TempFileName As String
    Dim FileFullPath As String
    Dim FileFormat As Variant
    Dim Wb1 As Workbook
    Dim Wb2 As Workbook

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With
    Set Wb1 = ThisWorkbook
    ActiveSheet.Copy
    Set Wb2 = ActiveWorkbook
    
    'Below code will get the File Extension and
    'the file format which we want to save the copy
    'of the workbook with the active sheet.
    
    With Wb2
        If Val(Application.Version) < 12 Then
             FileExt = ".xls": FileFormat = -4143
        Else
            Select Case Wb1.FileFormat
            Case 51: FileExt = ".xlsx": FileFormat = 51
            Case 52:
                If .HasVBProject Then
                    FileExt = ".xlsm": FileFormat = 52
                Else
                    FileExt = ".xlsx": FileFormat = 51
                End If
            Case 56: FileExt = ".xls": FileFormat = 56
            Case Else: FileExt = ".xlsb": FileFormat = 50
            End Select
        End If
    End With

    'Save your workbook in your temp folder of your system
    'below code gets the full path of the temporary folder
    'in your system
    
    TempFilePath = Environ$("temp") & "\"

    'Now append a date and time stamp
    'in your new file
    
    TempFileName = Wb1.Name & "-" & Format(Now, "dd-mmm-yy h-mm-ss")

    'Complete path of the file where it is saved
    FileFullPath = TempFilePath & TempFileName & FileExt
    
    'Now save your currect workbook at the above path
    Wb2.SaveAs FileFullPath, FileFormat:=FileFormat
    
    'Now open a new mail
    
    Set OlApp = CreateObject("Outlook.Application")
    Set NewMail = OlApp.CreateItem(0)
    
    On Error Resume Next
    With NewMail
        .To = "info@learnexcelmacro.com"
        .CC = "info@learnexcelmacro.com"
        .BCC = "info@learnexcelmacro.com"
        .Subject = "Type your Subject here"
        .Body = "Type the Body of your mail"
        .Attachments.Add FileFullPath '--- full path of the temp file where it is saved
        .Send   'or use .Display to show you the email before sending it.
    End With
    On Error GoTo 0
    
    'Since mail has been sent with the attachment
    'Now close and delete the temp file from the
    'temp folder
    Wb2.Close SaveChanges:=False
    Kill FileFullPath
    
    'set nothing to the objects created
    Set NewMail = Nothing
    Set OlApp = Nothing
    
    'Now set the application properties back to true
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub

Note: The above code sends the activesheet as an attachment by email. But if you want to send any particular Sheet in the mail as an attachment, then use the below line in the above code:

ActiveSheet.Copy => Sheets(“Sheet_Name”).Copy

cover3d_0-89071700_1484285537__1_

Join over 10, 000+ Excel VBA Enthusiasts & get this FREE e-Book Now!