Code to Attach Current Worksheet to Outlook Email

[Hannah Lively]

Good Morning,

I am in need of assistance in writing a code to use an ActiveX Command Button to attach the current worksheet to a new email in Outlook.

Thank you

 

[Logit]

Paste into a Routine Module:

Option Explicit

Sub Email_Sheet()

  Dim oApp As Object
  Dim oMail As Object
  Dim LWorkbook As Workbook
  Dim LFileName As String

  'Turn off screen updating
  Application.ScreenUpdating = False

  'Copy the active worksheet and save to a temporary workbook
  ActiveSheet.Copy
  Set LWorkbook = ActiveWorkbook

  'Create a temporary file in your current directory that uses the name
  ' of the sheet as the filename
  LFileName = LWorkbook.Worksheets(1).Name
  On Error Resume Next
  'Delete the file if it already exists
  Kill LFileName
  On Error GoTo 0
  'Save temporary file
  LWorkbook.SaveAs Filename:=LFileName

  'Create an Outlook object and new mail message
  Set oApp = CreateObject("Outlook.Application")
  Set oMail = oApp.CreateItem(0)

  'Set mail attributes (uncomment lines to enter attributes)
  ' In this example, only the attachment is being added to the mail message
  With oMail
      .To = "user@yahoo.com"
      .Subject = "Subject"
      .body = "This is the body of the message." & vbCrLf & vbCrLf & _
      "Attached is the file"
      .Attachments.Add LWorkbook.FullName
      .Display 'change to .Send if you don't want to preview the email first.
  End With

  'Delete the temporary file and close temporary Workbook
  LWorkbook.ChangeFileAccess Mode:=xlReadOnly
  Kill LWorkbook.FullName
  LWorkbook.Close SaveChanges:=False

  'Turn back on screen updating
  Application.ScreenUpdating = True
  Set oMail = Nothing
  Set oApp = Nothing

End Sub