Incluir firma cuando envío un mail con cuenta de gmail
Publicado por alexis (1 intervención) el 02/10/2013 10:14:02
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?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
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 ThenMsgBox "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.MessageDim 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 = TrueElse
'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 = NothingEnd If
'libero posibles errores
On Error GoTo 0
End Function
Valora esta pregunta
0