Macro convierte a PDF y envía email Outlook
Para Dante amor.
Hola de nuevo, esta es la macro que me ayudaste a hacer, envía los correos desde gmail, ¿me puedes ayudar paraq ue sea desde la app de Outlook y no de gmail?
¡Gracias!
[code]Sub Pdf_Enviar_Correos_Gmail()'---
' Por.Dante Amor
'---
'***Macro Para enviar correos por Gmail
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set h = Sheets("REGISTRO")
'
correo = "[email protected]" 'correo gmail
passwd = "pwd" 'tu password
'
ruta = "C:\Users\itumi\Desktop\PRUEBAS\"
'ruta = ThisWorkbook.Path & "\"
h.Select
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
'
archivo = ruta & Cells(i, "A").Value & ".pdf"
Cells(i, "A").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=archivo, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
'
Dim Email As CDO.Message
Set Email = New CDO.Message
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
With Email.Configuration.Fields
.Item("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
.Item("http://schemas.microsoft.com/cdo/" & "configuration/smtpauthenticate") = Abs(1)
.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = correo
.Item("http://schemas.microsoft.com/cdo/configuration/sendpassword") = passwd
.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
End With
With Email
.To = Range("B" & i).Value 'Destinatarios
.From = correo
.Subject = "Asunto"
.TextBody = "Cuerpo del mensaje"
If Dir(archivo) <> "" Then
.AddAttachment archivo
End If
.Configuration.Fields.Update
On Error Resume Next
.Send
If Err.Number = 0 Then
Cells(i, "C") = "El mail se envió con éxito"
Else
Cells(i, "C") = "Se produjo el siguiente error: " & Err.Number & " " & Err.Description
End If
On Error GoTo 0
End With
Set Email = Nothing
Next
MsgBox "Correos enviados", vbInformation, "
1 Respuesta
Respuesta de Dante Amor
2
Te anexo la macro para outlook
Sub Pdf_Enviar_Correos_Gmail()
'---
' Por.Dante Amor
'---
'***Macro Para enviar correos por Outlook
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Set h = Sheets("REGISTRO")
'
ruta = "C:\Users\itumi\Desktop\PRUEBAS\"
'ruta = ThisWorkbook.Path & "\"
h.Select
For i = 2 To Range("B" & Rows.Count).End(xlUp).Row
'
archivo = ruta & Cells(i, "A").Value & ".pdf"
Cells(i, "A").ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=archivo, _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
'
Set dam = CreateObject("Outlook.Application").CreateItem(0)
dam.To = Range("B" & i).Value 'Destinatarios
dam.Subject = "Asunto"
dam.Body = "Cuerpo del mensaje"
If Dir(archivo) <> "" Then
dam.Attachments.Add archivo
End If
Dam. Send 'El correo se envía en automático
'dam. Display 'El correo se muestra
Cells(i, "C") = "El mail se envió con éxito"
Set dam = Nothing
Next
MsgBox "Correos enviados", vbInformation, ""
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
¡Gracias! Te envíe otra pregunta gracias, gracias
*_*
No tengo publisher, por eso no respondí.
Pero no olvides valorar esta respuesta.
