Como se puede obviar el mensaje que entrega el outlook cuando se ejecuta una macro para el envío

Con la siguiente función podrás enviar un email desde excel, cópiala y pégala en un modulo.

Function EnviarMails_CDO(ByVal Destinario As String, ByVal Remitente As String, ByVal Contraseña As String, ByVal Asunto As String, _
Optional ByVal Mensaje As String = "", Optional ByVal RutaAdjunto As String = "") As Boolean
'Creo la variable de objeto CDO
Dim Email As CDO.Message
Dim Autentificación As Boolean
'ahora doy vida al objeto
Set Email = New CDO.Message
'indicamos los datos del servidor:
'Servidor gmail
'Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
'Servidor yahoo
Email.Configuration.Fields(cdoSMTPServer) = "smtp.mail.yahoo.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
'indicamos el nro de puerto. por defecto es el 25, pero gmail usa el 465. hay otro
'(que ahora no recuerdo) pero no me funcionaba... por eso no lo usé mas y lo olvidé
'Puerto gmail
'Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
'Puerto yahoo
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
'aquí dejamos en claro si el servidor que usamos requiere o nó autentificación.
'1=requiere, 0=no requiere. Para gmail, entonces, 1
'Autentificación para gmail
'Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
"configuration/smtpauthenticate") = Abs(1)
'Autentificación para yahoo
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" & _
"configuration/smtpauthenticate") = Abs(1)
'segundos para el tiempo máximo de espera. aconsejo no modificarlo:
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
'aquí defino como True (verdadera) a la autentificación para el envío de mails.
Autentificación = True
'ahora configuramos las opciones de login de gmail:
If Autentificación Then
'nombre de usuario
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusername") = Remitente '"[email protected]"
'contraseña
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Contraseña
'si el servidor utiliza SSL (secure socket layer). en gmail: True
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End If
'a partir de ahora tomaremos los datos incluidos en el la hoja de excel:
' Dirección del Destinatario
Email.To = Destinario 'Trim([e1].Value)
' Dirección del remitente
Email.From = Remitente 'Trim([e2].Value)
' Asunto del mensaje
Email.Subject = Asunto 'Trim([e3].Value)
If Mensaje = "" Then
Mensaje = ""
End If
' Cuerpo del mensaje
Email.TextBody = Mensaje 'Trim([e4].Value)
'Ruta del archivo adjunto
If RutaAdjunto <> vbNullString Then
Email.AddAttachment (RutaAdjunto) 'Trim([e5].Value))
End If
'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 descripción y nro de error
MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If
'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

'Recuerda hacer los ajustes de los servidores de envío y llegada de acuerdo al proveedor.

El siguiente procedimiento es un ejemplo de como enviar un email usando la anterior función:

Private Sub EnviarMail()
Dim MailExitoso As Boolean
Dim Mensaje, Email, Brouchure
Email = "[email protected]"
Mensaje = "Esto es una prueba"
'llamo a la función:
MailExitoso = EnviarMails_CDO(Email, "[email protected]", "contraseña", "Titulo del Asunto", Mensaje, "C:\ArchivoAdjunto.pdf")
'si me devuelve un resultado Verdadero, todo salió bien:
If MailExitoso = True Then
MsgBox "El mail fué enviado satisfactoriamente", vbInformation, "Informe"
Else
MsgBox "El mail no pudo ser enviado", vbCritical, "Email"
End If
End Sub

También es importante que en VBA en el menú Herramientas - Referencias habilites o adiciones Microsoft CDO para Windows 2000 library.

Todo es un poco extenso pero vale la pena el resultado y ten encuenta que no se pasa por Outlook.

Espero te sirva. Feliz dia

Juan Carlos

estimado tengo el siguiente código como lo puedo adecuar

Sub envío()
For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
Set parte1 = CreateObject("outlook.application")
Set parte2 = parte1.createitem(olmailitem)
Set parte3 = parte1.createitem(olmailitem)
parte2.to = Range("C" & i)
parte2.Subject = "Diferencias"
parte2.body = "Buenos Días"
parte2.display 'aquí puedes poner send y lo enviará directamente
Set parte1 = Nothing
Set parte2 = Nothing
Next
End Sub

Copia y pega el siguiente codigo:

Sub envío()
'Este código solo funciona para Office 2007-2010
'Debes adicionar la referencia a Microsoft Outlook Library
Dim OutApp
Dim OutMail
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(olMailItem)
For i = 2 To Range("C" & Rows.Count).End(xlUp).Row
strbody = "Hi there" & vbNewLine & vbNewLine & _
"This is line 1" & vbNewLine & _
"This is line 2" & vbNewLine & _
"This is line 3" & vbNewLine & _
"This is line 4"
On Error Resume Next
With OutMail
.To = Range("C" & i)
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.Body = strbody
'SendUsingAccount is new in Outlook 2007
'Change Item(1)to another number to use another account
.SendUsingAccount = OutApp.Session.Accounts.Item(1)
.Send 'or use .Display
End With
On Error GoTo 0
Next i
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

Hice la prueba en mi pc colocando en la columna C desde la fila 2 hasta la 10 los correos y funciono. Ten presente que el Outlook debe estar configurado en el equipo donde se va ejecutar y debes hacer referencia a la librería Microsoft Outlook Library.

Feliz Dia

Juan Carlos

Juan Carlos

Probé el código y me sigue apareciendo el mensaje de outlook, me mencionaron un programa click yes tu sabes como se ocupa

Víctor buen dia

Por favor dame tu correo y te enviare el archivo para que lo pruebes.

Juan Carlos

[email protected]