Gmail: Incluir firma con macros

[Cerrado]
Denunciar
Message postés
1
Date d'inscription
miércoles, 2 de octubre de 2013
Estatus
Miembro
Última intervención
miércoles, 2 de octubre de 2013
-
Hola,

He creado una macro que envía mails desde mi cuenta de gmail. Los mails se envían bien. El problema es que no incluye la firma configurada en gmail cuando lo envío desde la macro. ¿Cómo puedo hacer para que incluya la firma en el mensaje?

Sub EnviarMail()
Dim MailExitoso As Boolean
'llamo a la funcion:
MailExitoso = EnviarMails_CDO()
'si me devuelve un resultado Verdadero, todo salió bien:
If MailExitoso = True Then
MsgBox "El mail fué enviado satisfactoriamente", vbInformation, "Informe"
End If
End Sub

Function EnviarMails_CDO() As Boolean

' Creo la variable de objeto CDO
Dim Email As CDO.Message
Dim Autentificion As Boolean
' ahora doy vida al objeto
Set Email = New CDO.Message

Set wsDest = Sheets(1)
Set tablaDest = wsDest.ListObjects("TablaDestinatarios")
' Cuenta la cantidad de filas de la tabla
cantDest = tablaDest.ListRows.Count
'indicamos los datos del servidor:
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
'indicamos el nro de puerto
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
'autentificación
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
"configuration/smtpauthenticate") = Abs(1)
'segundos para el tiempo maximo de espera
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30


' autentificación para el envío de mails.
Autentificacion = True
' opciones de login de gmail:
If Autentificacion Then
'nombre de usuario
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = Trim([b1].Value)
'contraseña
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Trim([b2].Value)
' SSL (secure socket layer)
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End If

' Dirección del remitente
Email.From = Range("B1").Value

'Ruta de los archivos adjuntos
If [b3].Value <> vbNullString Then
Email.AddAttachment (Trim([b3].Value))
End If
If [c3].Value <> vbNullString Then
Email.AddAttachment (Trim([c3].Value))
End If
If [d3].Value <> vbNullString Then
Email.AddAttachment (Trim([d3].Value))
End If
If [e3].Value <> vbNullString Then
Email.AddAttachment (Trim([e3].Value))
End If

For i = 1 To cantDest

' Dirección del Destinatario
Email.To = tablaDest.DataBodyRange.Cells(i, 3)

' Asunto del mensaje
Email.Subject = tablaDest.DataBodyRange.Cells(i, 2) & ", xxxxxxxxxxxxx"

' Cuerpo del mensaje
Email.HTMLBody = Range("B4").Value & Trim(tablaDest.DataBodyRange.Cells(i, 1).Value) & Range("C4").Value

'antes de enviar actualizamos los datos:
Email.Configuration.Fields.Update
'colocamos un capturador de errores, por las dudas:
On Error Resume Next
'enviamos el mail
Email.Send
'si el numero de error es 0 (o sea, no existieron errores en el proceso),
'hago que la función retorne Verdadero
If Err.Number = 0 Then
EnviarMails_CDO = True
Else
'caso contrario, muestro un MsgBox con la descripcion y nro de error
MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If

Next i

'destruyo el objeto, para liberar los recursos del sistema
If Not Email Is Nothing Then
Set Email = Nothing
End If
'libero posibles errores
On Error GoTo 0

End Function