Validar si encuentra archivo adjunto VBA macro gmail
Public impresiones As Integer
Sub SendMail_Gmail2()
Dim myrange As Range
Dim contador As Integer
Set myrange = Worksheets("Hoja1").Range("A:A")
contador = Application.WorksheetFunction.CountA(myrange)
contador = 4
For i = 2 To contador
Dim Email As CDO.Message
Set Email = New CDO.Message
correo = "[email protected]"
passwd = "12345678"
destino1 = Range("D" & i)
destino2 = Range("E" & i)
destino3 = Range("F" & i)
destino4 = Range("G" & i)
destino5 = Range("H" & i)
destino6 = Range("I" & i)
cliente = Range("B" & i)
mensaje = "TITULO"
cuerpo = "CONTENIDO"
archivo = Range("K" & i)
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 = destino1 & ", " & destino2 & ", " & destino3 & ", " & destino4 & ", " & destino5 & ", " & destino6
.From = correo
.Subject = mensaje
.TextBody = cuerpo
.AddAttachment archivo
.Configuration.Fields.Update
On Error Resume Next
'If .Attachments.Item(Index) Is Nothing Then
'MsgBox "no hay adjunto para: " & cliente
'End If
.Send
End With
If Err.Number = 0 Then
MsgBox "El mail se envió con éxito a: " & cliente, vbInformation, "Mensaje Administrador"
impresiones = impresiones + 1
Else
MsgBox "Se produjo el siguiente error: " & Err.Description, vbCritical, "Error nro " & Err.Number
End If
Next
MsgBox "Se han enviado " & impresiones & " E-Mails correctamente"
impresiones = 0
End Sub
Hola, tengo esta macro que envia varios correos al tiempo con diferentes adjuntos a X cantidad de correos previamente especificados... Siempre los correos deben llevar un adjunto (es la razon de ser del correo), estoy intentando que cuando no encuentre el adjunto me muestre un error y salte automaticamente a enviar el otro correo, pero es el momento que no he encontrado la manera de hacerlo, solicito de su colaboracion. Mil gracias de antemano... Victor
1 Respuesta
Te anexo el código actualizado, en la columna "Z" te pondrá el resultado:
"no existe el archivo", "El mail se envió con éxito" o "Se produjo el siguiente error"
Public impresiones As Integer
Sub SendMail_Gmail2()
Dim myrange As Range
Dim contador As Integer
Set myrange = Worksheets("Hoja1").Range("A:A")
contador = Application.WorksheetFunction.CountA(myrange)
contador = 4
For i = 2 To contador
Dim Email As CDO.Message
Set Email = New CDO.Message
correo = "[email protected]"
passwd = "12345678"
destino1 = Range("D" & i)
destino2 = Range("E" & i)
destino3 = Range("F" & i)
destino4 = Range("G" & i)
destino5 = Range("H" & i)
destino6 = Range("I" & i)
cliente = Range("B" & i)
mensaje = "TITULO"
cuerpo = "CONTENIDO"
archivo = Range("K" & i)
ruta = ThisWorkbook.Path & "\"
If Dir(ruta & archivo) = "" Then
Range("Z" & i) = "No existe el archivo"
Else
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 = destino1 & ", " & destino2 & ", " & destino3 & ", " & destino4 & ", " & destino5 & ", " & destino6
.From = correo
.Subject = mensaje
.TextBody = cuerpo
.AddAttachment archivo
.Configuration.Fields.Update
On Error Resume Next
'If .Attachments.Item(Index) Is Nothing Then
'MsgBox "no hay adjunto para: " & cliente
'End If
.Send
End With
If Err.Number = 0 Then
Range("Z" & i) = "El mail se envió con éxito a: " & cliente
impresiones = impresiones + 1
Else
Range("Z" & i) = "Se produjo el siguiente error: " & Err.Description & ". Error nro " & Err.Number
End If
End If
Next
MsgBox "Se han enviado " & impresiones & " E-Mails correctamente"
impresiones = 0
End Sub.
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
.
Avísame cualquier duda
.
Hola Dante, mil gracias por tu pronta respuesta.
Me esta mostrando error aquí If Dir(ruta & archivo) = "" Then me dice que error 52 (nombre o numero de archivo incorrecto), ¿sera alguna librería que debo activar? Gracias
¿Qué versión de excel tienes?
En el momento del error, ¿revisa qué dato tienes en la variable archivo? ¿Y qué dato tienes en la variable ruta?
Estas son las referencias que tengo activadas:
¿Modificaste algo más en la macro?
