Adaptar esta macro a Yahoo para mandar
Me podrías adaptar esta macro para que se mandara con YAHOO en vez de con outlook
COmo siempre gracias
Sub Macro5()
' Por Dante Amor
'
' Envía rango por correo
'
'VALIDACIONES
If Range("K4").Value = "" Then
MsgBox "Falta el nombre de archivo"
Exit Sub
End If
If Range("K1").Value = "" Then
MsgBox "Falta el destinatario"
Exit Sub
End If
'
ruta = ThisWorkbook.Path & "\"
arch = Range("K4").Value & ".pdf"
para = Range("K1").Value
asunto = Range("K2").Value
cuerpo = Range("K3").Value
Range("A1:G26").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ruta & arch, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Set dam = CreateObject("outlook.application").createitem(0)
dam.To = para
dam.Subject = asunto
dam.Body = cuerpo
dam.Attachments.Add ruta & arch
Dam. Send 'El correo se envía en automático
'dam. Display 'El correo se muestra
End Sub
1 Respuesta
Respuesta de Dante Amor
3
Te anexo la macro. Ya la probé y sí envía correos desde Yahoo.
Debes realizar las instrucciones:
1. Entra al menú VBA y en Herramientas / Referencias, tienes que activar la referencia Microsoft CDO for Windows 2000 Library:
2. En un módulo de VBA pon la siguiente macro:
Sub Enviar_Correo_Por_Yahoo() 'Act.Por Dante Amor correo = "[email protected]" Password = "password" rango = "A1:G26" arch = Range("K4").Value & ".pdf" para = Range("K1").Value asunto = Range("K2").Value cuerpo = Range("K3").Value ' Set Email = New CDO.Message Email.Configuration.Fields(cdoSMTPServer) = "smtp.mail.yahoo.com" Email.Configuration.Fields(cdoSendUsingMethod) = 2 Email.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465 '25 465 587 Email.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = Abs(1) Email.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30 Email.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo Email.Configuration.Fields.Item _ ("http://schemas.microsoft.com/cdo/configuration/sendpassword") = Password Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True DoEvents ' ruta = ThisWorkbook.Path & "\" Range(rango).ExportAsFixedFormat Type:=xlTypePDF, Filename:=ruta & arch, _ Quality:=xlQualityStandard, IncludeDocProperties:=True, _ IgnorePrintAreas:=False, OpenAfterPublish:=False ' Email.From = correo Email.To = para Email.Subject = asunto Email.TextBody = cuerpo Email.AddAttachment ruta & arch Email.Configuration.Fields.Update On Error Resume Next Email.Send werr = Err.Number & " " & Err.Description MsgBox "Mensaje del Correo enviado: " & werr, vbInformation End Sub
3. Actualiza en la macro la siguiente información:
correo = "[email protected]" Password = "password" rango = "A1:G26" arch = Range("K4").Value & ".pdf" para = Range("K1").Value asunto = Range("K2").Value cuerpo = Range("K3").Value
4. En tu cuenta de Yahoo.
- Entra a tu cuenta y entra a información de tu cuenta
- Después selecciona Seguridad de la cuenta.
- Y por último Activa la opción "Permitir aplicaciones con métodos de ingreso menos seguros"
Listo, ve a la macro y realiza el envío.
[Sal u dos, no olvides valorar la respuesta.
Muchas gracias!!! - Jorge Cue