Problemas con la macro para enviar correos

Estimados tengo el siguiente problema con la macro que envía un correo desde excel;

no logro dar con el código para guardar como, y que este guarde con la referencia de una celda, al mismo tiempo que se guarda en una carpeta denominada planilla se debiera genera el correo y en el asunto debiera tomar la referencia de las mismas celdas con la que se guardo el documento y por ultimo que la persona que lo lea no pueda modificar nada de esta planilla:

Aquí les dejo la macro

Sub EnviarEmail()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("outlook.application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = "correo"
.CC = ""
.BCC = ""
.Subject = "Aquí Escribe el asunto determinado"
.Body = "Un texto especial que quieras escribir"
.Attachments.Add ActiveWorkbook.FullName
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub