UniversoExcelForo

Respuesta a consultas.
Fecha de creación: 09.Abril.2012

Fundadores: Wibly,Tyno,Servando,Sakkar,Rosendo2,RMaximo,Railar,Mcoronel,Ioyama,Igtelo,Hugotron,Drochar,Dedos,Alberto,Adolfo

No se pueden hacer consultas de Excel o VBA por mensaje privado.
Utiliza el botón buscar del foro y te ahorras tiempo para obtener "ayuda".

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

viru88


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?


Código:
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

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.