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?
Respuesta de Dante Amor
1
Revisa las siguientes respuestas
¡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.
