I just want to attach sheet 2 to my email, not the entire workbook

[Yakillinmesmalls]

Hi, I'm creating an Incident Management form that has two buttons. One for injuries and the other for near misses. when the injury button is clicked, a message pops up instructing the employee on next steps, once the OK button is clicked on the message box, the email pops up where the employee just has to fill out the questions in the body, open and save the attached injury report form to their desktop, fill it out and attach the completed form back to the email that is already populated with the required recipients. Problem I'm running into is that I want the sheet 2 that has the injury report form to be attached, not sheet 1 that has the two buttons. How do I achieve this?

Private Sub CommandButton1_Click()
Dim xOutlookObj As Object
Dim xOutApp As Object
Dim xOutMail As Object
Dim xMailBody As String
On Error Resume Next
Set xOutApp = CreateObject("Outlook.Application")
Set xOutMail = xOutApp.CreateItem(0)
xMailBody = "Description of Injury:" & vbNewLine & vbNewLine & _
"Type of Injury:" & vbNewLine & vbNewLine & _
"Treatment Disposition (First-Aid, ER, Urgent Care, etc.):"
On Error Resume Next
With xOutMail
.To = "ObviouslynotmyrealEmail.com"
.CC = ""
.BCC = ""
.Subject = "Injury Report (Location and Date of Injury)"
.Body = xMailBody
.Attachments.Add ActiveWorkbook.FullName
MsgBox Prompt:="Click OK; Fill out email; Save attachment as IR-(Date of Injury) to desktop; attach completed form to email and Send"
.Display 'or use .Send
End With
On Error GoTo 0
Set xOutMail = Nothing
Set xOutApp = Nothing
End Sub

 

[DanteAmor]

Try if the following is what you need.
If not, could you explain a bit more.

Private Sub CommandButton1_Click()
  Dim xOutlookObj As Object
  Dim xOutApp As Object
  Dim xOutMail As Object
  Dim xMailBody As String
  Dim sPath As String, sFile As String

  Set xOutApp = CreateObject("Outlook.Application")
  Set xOutMail = xOutApp.CreateItem(0)
  xMailBody = "Description of Injury:" & vbNewLine & vbNewLine & _
    "Type of Injury:" & vbNewLine & vbNewLine & _
    "Treatment Disposition (First-Aid, ER, Urgent Care, etc.):"
  '
  sPath = CreateObject("WScript.Shell").specialfolders("Desktop") & "\"
  sFile = "IR-" & Format(Date, "dd-mm-yyyy") & ".xlsx"
  Sheets("Sheet2").Copy
  ActiveWorkbook.SaveAs sPath & sFile
  ActiveWorkbook.Close False
  '
  On Error Resume Next
  With xOutMail
    .To = "ObviouslynotmyrealEmail.com"
    .CC = ""
    .BCC = ""
    .Subject = "Injury Report (Location and Date of Injury)"
    .Body = xMailBody
    .Attachments.Add sPath & sFile
    MsgBox Prompt:="Click OK; Fill out email; Save attachment as IR-(Date of Injury) to desktop; attach completed form to email and Send"
    .Display 'or use .Send
  End With
  On Error GoTo 0
  Set xOutMail = Nothing
  Set xOutApp = Nothing
End Sub

 

[Yakillinmesmalls]

Try if the following is what you need.
If not, could you explain a bit more.

Private Sub CommandButton1_Click()
  Dim xOutlookObj As Object
  Dim xOutApp As Object
  Dim xOutMail As Object
  Dim xMailBody As String
  Dim sPath As String, sFile As String

  Set xOutApp = CreateObject("Outlook.Application")
  Set xOutMail = xOutApp.CreateItem(0)
  xMailBody = "Description of Injury:" & vbNewLine & vbNewLine & _
    "Type of Injury:" & vbNewLine & vbNewLine & _
    "Treatment Disposition (First-Aid, ER, Urgent Care, etc.):"
  '
  sPath = CreateObject("WScript.Shell").specialfolders("Desktop") & "\"
  sFile = "IR-" & Format(Date, "dd-mm-yyyy") & ".xlsx"
  Sheets("Sheet2").Copy
  ActiveWorkbook.SaveAs sPath & sFile
  ActiveWorkbook.Close False
  '
  On Error Resume Next
  With xOutMail
    .To = "ObviouslynotmyrealEmail.com"
    .CC = ""
    .BCC = ""
    .Subject = "Injury Report (Location and Date of Injury)"
    .Body = xMailBody
    .Attachments.Add sPath & sFile
    MsgBox Prompt:="Click OK; Fill out email; Save attachment as IR-(Date of Injury) to desktop; attach completed form to email and Send"
    .Display 'or use .Send
  End With
  On Error GoTo 0
  Set xOutMail = Nothing
  Set xOutApp = Nothing
End Sub

Your code didn't work. I tried something similar and it says sheet 2 is out of range

 

[Yakillinmesmalls]

Your code didn't work. I tried something similar and it says sheet 2 is out of range

Runtime error 9

 

[DanteAmor]

Your code didn't work. I tried something similar and it says sheet 2 is out of range

I suppose that the error is in this line, if not, you should comment in which line you have the error.

Sheets("Sheet2").Copy

Problem I'm running into is that I want the sheet 2 that has the injury report form to be attached

You must put the name of the sheet you want to save in the file.