VBA spørgsmål/hjælp

Er der en excelhaj som kan svare/hjælpe med nedenstående. ;-)
Jeg har en vba kode i en excelfil, der vedhæfter filen til mail i outlook.
Det fungerer rigtig godt, men er det muligt, at tage specifikt ark/sheet og vedhæfte den som fil til mail i outlook? Hvis muligt, kan filen så få samme navn som ark/sheet navnet og vedhæftes som .xlsm?

Nuværende kode:
Sub excelfil_til_Outlook()
    Dim wb1 As Workbook
    Dim TempFilePath As String
    Dim TempFileName As String
    Dim FileExtStr As String
    Dim OutApp As Object
    Dim OutMail As Object

    With Application
        .ScreenUpdating = False
        .EnableEvents = False
    End With

    Set wb1 = ActiveWorkbook

    TempFilePath = Environ$("temp") & "\"
    TempFileName = wb1.Name
    FileExtStr = "." & LCase(Right(wb1.Name, Len(wb1.Name) - InStrRev(wb1.Name, ".", , 1)))

    wb1.SaveCopyAs TempFilePath & TempFileName & FileExtStr

    Set OutApp = CreateObject("Outlook.Application")
    Set OutMail = OutApp.CreateItem(0)

    On Error Resume Next

    With OutMail
        .Display
        .To = Range("D6")
        .CC = Range("D7")
        .BCC = ""
        .Subject = wb1.Name
        .HTMLBody = "<br>" & .HTMLBody
        .Attachments.Add TempFilePath & TempFileName & FileExtStr
        .Display
    End With
    On Error GoTo 0

    Kill TempFilePath & TempFileName & FileExtStr

    Set OutMail = Nothing
    Set OutApp = Nothing

    With Application
        .ScreenUpdating = True
        .EnableEvents = True
    End With
End Sub