Enviar correos automáticamente con VBA
Tengo una macro para enviar correos automáticamente, el problema es que quiero que me adjunte tres archivos y todo bien, solo que en ocasiones no siempre existen los tres archivos y me salta el error, yo querría que el e-mail se enviara con los adjuntos que haya en las tres celdas indicadas, si una o todas las celdas están vacías que no me salte el error, que simplemente lo envíe con los adjuntos que existan o sin los adjuntos si es que las tres celdas están vacías.
Sub Enviar_email()
Application.ScreenUpdating = False
Dim Filenames As String
Filenames = Dir("C:\temp\email\*.xls*")
Do Until Filenames = ""
Workbooks.Open "C:\temp\email\" & Filenames
Range("A:L").Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Item.Sentonbehalfofname = "[email protected]"
.Item.To = Range("N3").Value
.Item.CC = Range("N4").Value
.Item.Subject = Range("Q2").Value
.Item.Attachments.Add Range("N5").Value
.Item.Attachments.Add Range("N6").Value
.Item.Attachments.Add Range("N7").Value
.Item.Send
End With
Application.DisplayAlerts = False
Windows(Filenames).Close
Kill "C:\temp\email\" & Filenames
Application.DisplayAlerts = True
Filenames = Dir
Loop
Kill "C:\temp\Adjuntos\*.xls*"
Application.ScreenUpdating = True
End Sub
1 respuesta
Veo que no estás controlando posibles errores, una posibilidad es que le hagas la siguiente pequeña modificación:
Sub Enviar_email()
Application.ScreenUpdating = False
Dim Filenames As String
Filenames = Dir("C:\temp\email\*.xls*")
Do Until Filenames = ""
Workbooks.Open "C:\temp\email\" & Filenames
Range("A:L").Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Item.Sentonbehalfofname = "[email protected]"
.Item.To = Range("N3").Value
.Item.CC = Range("N4").Value
.Item.Subject = Range("Q2").Value
'Esta es la instrucción extra----------------
On Error Resume Next
'--------------------------------------------
.Item.Attachments.Add Range("N5").Value
.Item.Attachments.Add Range("N6").Value
.Item.Attachments.Add Range("N7").Value
.Item.Send
End With
Application.DisplayAlerts = False
Windows(Filenames).Close
Kill "C:\temp\email\" & Filenames
Application.DisplayAlerts = True
Filenames = Dir
Loop
Kill "C:\temp\Adjuntos\*.xls*"
Application.ScreenUpdating = True
End SubSalu2
Hola Gustavo,
Si que lo había contemplado pero cuando incluyo este control de error me omite, a partir de no encontrar el adjunto que falte, esa celda y no vuelve a adjuntar ese archivo aunque éste exista.
Gracias!!!
Yo llego a entender lo que planteás, si el archivo no existe (y por eso te está dando el error), ¿cómo es que después decís que sí existe?
Igualmente podrías deshabilitar esa instrucción luego, una posibilidad sería hacer algo así...
Sub Enviar_email()
Application.ScreenUpdating = False
Dim Filenames As String
Filenames = Dir("C:\temp\email\*.xls*")
Do Until Filenames = ""
Workbooks.Open "C:\temp\email\" & Filenames
Range("A:L").Select
ActiveWorkbook.EnvelopeVisible = True
With ActiveSheet.MailEnvelope
.Item.Sentonbehalfofname = "[email protected]"
.Item.To = Range("N3").Value
.Item.CC = Range("N4").Value
.Item.Subject = Range("Q2").Value
On Error Resume Next
.Item.Attachments.Add Range("N5").Value
.Item.Attachments.Add Range("N6").Value
.Item.Attachments.Add Range("N7").Value
.Item.Send
On Error Goto 0
End With
Application.DisplayAlerts = False
Windows(Filenames).Close
Kill "C:\temp\email\" & Filenames
Application.DisplayAlerts = True
Filenames = Dir
Loop
Kill "C:\temp\Adjuntos\*.xls*"
Application.ScreenUpdating = True
End SubSalu2
Buenos días Gustavo,
Primero gracias por tu tiempo.
Disculpa porque posiblemente no me supe explicar bien. Utilizo esta macro para enviar masivamente correos, cada Filename es un excel y un correo a enviar, de estos archivos excel ha unos que tienen los tres attachments, es decir las tres celdas con datos (N5; N6 y N7), pero otros de los excel solo tienen uno o dos attachments, es decir una o dos de las celdas con datos, en tonces controlando los posibles errores como me indicabas, cuando envía un primer correo faltándole uno de los attachments ya no vuelve a adjuntar ese attachment aunque exista, es decir, aunque la celda correspondiente tenga datos.
Gracias de antemano.
¿Con la modificación al código (On Error Goto 0) tampoco se te arregló?
Salu2