Incluir firma digital de Outlook en macros Excel

Tengo un macros con un botón que envía un mensaje, pero al abrirlo sale sin la firma digital del usuario, ¿qué línea de código debo agregar?

1 respuesta

Respuesta
1

¡Gracias! 

Te anexo la macro.

En estas líneas tienes que poner la ruta y el nombre del archivo que contiene la firma digital.

 'DATOS PARA Incluir imagen para la firma
        rutalogo = "c:\trabajo\"
        logo = "firma.jpg"



Sub GuardaPDFyEnviaPorEmail()
    '
    Dim ProgCorreo, CorreoSaliente As Object
    '
    Set ProgCorreo = CreateObject("Outlook.Application")
    Set CorreoSaliente = ProgCorreo.createItem(0)
    '
    nbreLibro = "Recibo de Bodega " & Range("E6 ") & " " & Range("E9") & " para " & Range("E10")
    ruta = ThisWorkbook.Path & "\"
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=ruta & nbreLibro & ".pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False
    '
    'DATOS PARA Incluir imagen para la firma
        rutalogo = "c:\trabajo\"
        logo = "firma.jpg"
    '
    On Error Resume Next
    With CorreoSaliente
        .to = "email@email"
        .cc = "email@email"
        .Subject = nbreLibro
        .Attachments.Add ruta & nbreLibro & ".pdf"
        .Attachments.Add rutalogo & logo
        '
        cuerpo = "Estimados Señores.: <br>" & _
                 "Por favor ver adjunto los detalles del embarque en referencia. <br>" & _
                 "Gracias por su apoyo. <br> <br>"
        '
        .HTMLBody = "<HTML>" & "<BODY>" & "<P>" & _
            cuerpo & _
            "<img src=cid:" & logo & " height=100 width=100>" & _
            "</P>" & "</BODY> " & "</HTML>" & .HTMLBody
        .Display
    End With
    On Error GoTo 0
    Set CorreoSaliente = Nothing
    Set ProgCorreo = Nothing
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .DisplayAlerts = True
    End With
End Sub

[sal u dos

Hola Dante,

Gracias

He colocado el código,  me convierte el archivo pero no abre el mensaje de Outlook.

Dim ProgCorreo, CorreoSaliente As Object
Set ProgCorreo = CreateObject("Outlook.Application")
Set CorreoSaliente = ProgCorreo.createItem(0)
nbreLibro = "Recibo de Bodega " & Range("E6 ") & " " & Range("E8") & " para " & Range("E9")
ruta = ThisWorkbook.Path & "\"
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
ruta & nbreLibro & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:= _
True, IgnorePrintAreas:=False, OpenAfterPublish:=False
rutalogo = "C:\Users\Freddy Roque\Dropbox\PERSONAL"
logo = "Freddy Roque.png"
On Error Resume Next
With CorreoSaliente
.to = Email
.cc = "[email protected]"
.Subject = nbreLibro
.Attachments.Add ruta & nbreLibro & ".pdf"
.Attachments.Add rutalogo & logo
        '
cuerpo = "Estimados Señores.: <br>" & _
         "Por favor ver adjunto los detalles del embarque en referencia. <br>" & _
         "Gracias por su apoyo. <br> <br>"
        '
.HTMLBody = "<HTML>" & "<BODY>" & "<P>" & _
            cuerpo & _
            "<img src=cid:" & logo & " height=100 width=100>" & _
            "</P>" & "</BODY> " & "</HTML>" & .HTMLBody
 .Display
End With
On Error GoTo 0
Set CorreoSaliente = Nothing
Set ProgCorreo = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.DisplayAlerts = True
End With
End Sub

Este es mi ejemplo:

rutalogo = "c:\trabajo\"

Este es tu dato:

rutalogo = "C:\Users\Freddy Roque\Dropbox\PERSONAL"

Al final te falta la diagonal \


Quita esta línea:

On Error Resume Next

Y prueba nuevamente. Me dices qué mensaje de error te aparece.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas