VBA Send email with active workbook attached

Sub Button1_Click()
Set oApp = CreateObject("Outlook.Application")
    Set oMail = oApp.CreateItem(0)
   
 
    With oMail
        .To = Range("b1").Value
        .cc = Range("b2").Value
        .Subject = Range("b4").Value & " " & Date
        .body = "Hi All" & vbNewLine & vbNewLine & "Please find the updated spreadsheet." & vbNewLine & vbNewLine & "Regards" & vbNewLine & Application.UserName
        .Attachments.Add ActiveWorkbook.FullName
        .Display
        .Send
     
   
    End With
End Sub