Tengo Macro para convertir archivo de Excel a PDF, ahora quiero agregar que mande el PDF por correo

Te anexo la macro. Valida si existe la carpeta, si tienes datos en la ruta y el nombre. Si todo está bien, el archivo pdf se envía por outlook

Sub exportarPDF2()
'Act.Por.Dante Amor
    ruta = Cells(48, 5).Value
    nombre = Cells(47, 5).Value
    destinatario = Cells(49, 5).Value
    fecha = Sheets("FORMULAS").Cells(12, 2).Value
    '
    If ruta = "" Or nombre = "" Or destinatario = "" Then
        MsgBox "Completa los datos para enviar el correo"
        Exit Sub
    End If
    If Sheets("ReporteAct").Cells(46, 5) = 0 Then
        MsgBox "Debe existir al menos un registro", vbCritical, "Inconsistencia"
        Exit Sub
    End If
    '
    If Right(ruta, 1) <> "\" Then ruta = ruta & "\"
    If LCase(Right(nombre, 4)) <> ".pdf" Then nombre = nombre & ".pdf"
    If Dir(ruta, vbDirectory) = "" Then
        MsgBox "La carpeta no existe"
        Exit Sub
    End If
    '
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ruta & nombre, Quality:=xlQualityStandard, _
        includedocproperties:=True, ignoreprintareas:=False, openafterpublish:=False
    '
    Set dam = CreateObject("outlook.application").createitem(0)
    dam.To = destinatario
    dam.Subject = "Asunto"
    dam.Attachments.Add ruta & nombre
    dam.Display 'El correo se muestra
    dam.Send    'El correo se envía
    MsgBox "Archivo enviado"
End Sub

'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias

Me marco error, me mandaron mas respuestas y combinando funciono.

Solo me falta que en el correo en la parte de abajo de la redacción me aparezca la firma, en este caso es una imagen obligatoria de la empresa con mis datos y el escudo de la empresa.

Como puedo incluirlo en la redacción al final.

Esta es la Macro de como me funciono:

Sub exportarPDF()

nombre = Sheets("FORMULAS").Cells(31, 6).Value
ruta = Sheets("FORMULAS").Cells(32, 6).Value
destinatario = Sheets("FORMULAS").Cells(33, 6).Value
fecha = Sheets("FORMULAS").Cells(12, 2).Value

If Sheets("ReporteAct").Cells(46, 5) = 0 Then
MsgBox "Debe existir al menos un registro", vbCritical, "Inconsistencia"
Exit Sub
End If
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & nombre, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
Dim objOutlook As Object
Dim objItem As Object
Dim objNamespace As Object
Dim ADJUNTO As Variant

Set objOutlook = CreateObject("Outlook.Application")
Set objNamespace = objOutlook.GetNamespace("MAPI")
Set objItem = objOutlook.CreateItem(olMailItem)
objNamespace.Logon "EXCELSPACE", , True, True

'ADJUNTO = "C:\Users\jorge\Desktop\Reporte Actividades\nombredelarchivoadjunto.pdf"
'ADJUNTO =fichero

With objItem
.Attachments.Add ruta & nombre & ".pdf"
.Display
.To = destinatario
.CC = ""
.BCC = ""
.Subject = "Reporte Actividades"
.Body = "May buen día...... Anexo Reporte de Actividades del día " & fecha
.Send
End With

objNamespace.Logoff
Set objOutlook = Nothing
Set objItem = Nothing
Set objNamespace = Nothing

End Sub

Y esta es la imagen:

Recuerda cambiar la valoración a la respuesta, la macro que te puse funciona correctamente.

De lo contrario ya no podré ayudarte.