Enviar mail desde Excel VBA

Estoy intentando enviar un mail desde una macro de excel, el tema es que he conseguido que la envíe buscando información en esta misma web.
Ahora me encuentro con dos problemas, uno no se como poner más de una linea en el cuerpo del mensaje y dos cuando envío el mail el Outlook me dice:
Un programa esta intentando enviar correo electrónico automáticamente en su nombre ¿Desea permitirlo.?
El echo es que necesito que se envíe desde el outlook pero de forma desatendida.
Un saludo y gracias por adelantado.
Esta es la macro que estoy usando.
Sub Envio_Mail()
Dim objOL As New Outlook.Application
Dim objMail As MailItem
Set objOL = New Outlook.Application
Set objMail = objOL.CreateItem(olMailItem)
With objMail
.To = "[email protected]"
.Subject = "prueba mail"
.Body = "cuerpo del mensaje"
.Display
.Send
End With
Set objMail = Nothing
Set objOL = Nothing
End Sub

2 respuestas

Respuesta
1
Para insertar más de una linea debes de usar vbNewLine que es un salto de linea y concatenarlo con el operador & con nuestro texto
ejemplo:
"Hi there" & vbNewLine & vbNewLine & _
              "This is line 1" & vbNewLine & _
              "This is line 2" & vbNewLine & _
              "This is line 3" & vbNewLine & _
              "This is line 4"
Con respecto a tu segunda pregunta, este mensaje es una actualización de seguridad que microsoft hizo al outlook y no hay forma de desactivarlo. La otra forma es usando CDO, pero es más complejo, acá te envío un ejemplo utilizando una cuenta de hotmail o live, tienes que cambiar los datos de la cuenta y password
Sub Email()
Dim iMsg As Object
Dim iConf As Object
Dim Flds As Variant
Dim dato1 As String
Set iMsg = CreateObject("CDO.Message")
Set iConf = CreateObject("CDO.Configuration")
iConf.Load -1 ' CDO Source Defaults
Set Flds = iConf.Fields
With Flds
     'Sender's Mail ID
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "[email protected]"
            'Sender's Password
            .Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
            'Name/IP of SMTP Server
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.live.com"
            'Server Port
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
            'Send Using: (1) Local SMTP Pickup Service (2) Use SMTP Over Network
            .Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
            'Authentication Used: (1) None (2) Basic (3) NTLM
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
            'SMTP Server Requires SSL/STARTTLS: Boolean
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
            'Maximum Time in Seconds CDO will try to Establish Connection
            .Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 45
            'Update Configuration Entries
            .Update
End With
With iMsg
    Set .Configuration = iConf
    .To = "[email protected]"
    .CC = ""
    .BCC = ""
    .From = "[email protected]"
    .Subject = ""
    .TextBody = "hola mundo!!!!!!!!!"
    .Send
End With
Set iMsg = Nothing
Set iConf = Nothing
End Sub
Respuesta

He probado el código y me aparece el siguiente error:

Se ha producido el error '-2147220975 (80040211)' en tiempo de ejecución:

No se pudo enviar el mensaje al servidor SMTP. El Código de error de transporte fue 0x800ccc67. La respuesta del servidor fue 421 Cannot connect to SMTP server 65.55.176.126 (65.55.176.126:25) NB connect error 1460

¿A qué se debe?

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas