Expertos esta macro no me funciona

Necesito enviar un archivo excel como dato adjunto y una imagen pegada en el cuerpo del correo, en este momento me esta adjuntado la planilla y la imagen, no logro modificar la orden, les dejo el código para su revisión

'copiahoja()
Sheets("hoja1").Protect "tes2013"
Sheets("hoja2").Copy
Dim dia As String
Dim tim As String
Dim nom As String
Dim ext As String
Dim Path As String
dia = Format(Range("C5"), "DD-MM-YYYY")
tim = Format(Time(), "H-MM-SS")
ext = ".xls"
nom = nom + " " + dia + " " + "Hora" + " " + tim & ".xls"
Path = "d:\control" & nom
ActiveWorkbook.SaveAs Filename:=Path, FileFormat:=xlNormal
ActiveWorkbook.Close
Sheets("hoja1").Unprotect "tes2013"
Sheets("abonos").Select
Dim Izq As Single, Arr As Single, Ancho As Single, Alto As Single
Dim OutApp As Object
Dim OutMail As Object
Dim ultFil As Long
Dim fec As String
fec = Format(Now, "dd-mmm-yyyy")
Application.DisplayAlerts = False
ActiveWindow.Zoom = 64 'Reduce la hoja para que la imagen quede ajustada al mail
With Range("a1:n20") 'Rango a guardar como imagen
Izq = .Left: Arr = .Top: Ancho = .Width: Alto = .Height: .CopyPicture
End With
With ActiveSheet.ChartObjects.Add(Izq, Arr, Ancho, Alto)
.Chart.Paste
.Chart.Export "D:\imag_" & fec & ".jpg" 'directorio en donde guarda la imagen
.Delete
End With
ActiveWindow.Zoom = 64 'Vuelve la hoja a su condición original
Application.DisplayAlerts = True
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
Set OutMail = OutApp.CreateItem(0)
On Error Resume Next
With OutMail
.To = Range("P3").Value
.CC = Range("l2").Value
.BCC = ""
.Subject = "control" + " " + "del" + " " + Str(Date)
.Body = "Buenas Tardes:" + Chr(13) + Chr(13) + "Adjunto envío a usted informe de la referencia" + Chr(13) + Chr(13) + "Saludos."
.Attachments.Add "D:\control" + nom
.Attachments.Add "D:\imag_" & fec & ".jpg"
.display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing