El interés de mis lectores y la escasa información que en general se encuentra sobre el tema, han hecho del envío de mails desde Excel (utilizando macros) una de las entradas mas exitosas. Recibo constantes consultas al respecto (algunas no respondidas, disculpen) y ostenta un impresionante número de visitas y comentarios, que día a día se incrementan.
A muchos de Uds. les estoy debiendo el post que en estos momentos escribo: una esperada, y mejorada, segunda parte.
A muchos de Uds. les estoy debiendo el post que en estos momentos escribo: una esperada, y mejorada, segunda parte.
¿Que me lleva a retomar el tema? Sencillo: en la primera vimos como enviar 1 (un) mail... es decir... (y valga la redundancia) uno solo. Fue mas que suficiente para muchos proyectos, pero mis ingeniosos lectores necesitan mas y con sus preguntas dieron el siguiente paso: ¿como hago para remitir correos en base a una lista de direcciones de mails? En otras palabras: que Excel no dispare uno solo, si no que vaya leyendo de una tabla las direcciones y a cada una de ellas les envíe un mail. Algo así como un "mailing", desde Excel, lo que aliviaría mucho las tareas, automatizándolas por completo.
Eso veremos a continuación, aprovechando para tocar otros aspectos del procedimiento y armar un buen proyecto, en el cual intentaré integrar varias dudas planteadas.
Utilizaremos prácticamente el mismo código de la entrada anterior, aunque un poco mas "modularizado", para que así resulte ordenado y fácil de entender.
Entonces: tenemos una tabla con datos: nombre del cliente y mail. Podríamos agregar un par de campos, como el asunto, el cuerpo del mensaje y la ruta del archivo que le enviaremos anexado. De esta forma será posible automatizar la tarea, pero a la vez personalizar cada uno de los envíos:
Los pasos a seguir, en líneas generales, serían:
1) Almacenar la última fila ocupada de la tabla
2) Ir recorriendo registro x registro.
3) Si en la segunda columna hay una dirección de correo guardo la misma junto al asunto, el cuerpo del mensaje y, si la última columna de la tabla hay datos, la ruta de acceso al archivo adjunto que remitiré.
4) vuelvo al punto 3, hasta completar todos los registros y así dar por cerrado el bucle.
Como supuestamente vienen de leer la entrada anterior sobre el envío de mails, habrán notado que primero debemos establecer una conexión con Internet. Sería muy contraproducente que por cada envío abramos dicha conexión, ya que estaríamos desperdiciando recursos por todos lados. Antes de iniciar el recorrido por los registros de la tabla, nos conectamos una sola vez, enviamos todos los mails y por último cerramos la conexión. ¿Se entiende la idea?
Otras cuestiones: muy probablemente nos convenga revisar un poco la tabla antes de ponernos a enviar correos electrónicos. Supondrá una demora, pero no dudo que nos ahorrará tiempo al fin de cuentas. ¿Por qué? Sencillo: ¿que pasaría si en la última columna hacemos referencia a un archivo que no existe en la ubicación indicada? ¿O si a la dirección de mail le falta el @? Problemas, solo tendríamos problemas y errores que harían fracasar el objetivo de nuestra macro.
Crearé una función que revise bien los datos y alerte sobre las inconsistencias detectadas, para luego recién ahí dar paso al envío de mails:
Function RevisarTabla(Fin As Long) As String 'recorro todos los registros de la tabla, revisando: 'que haya una direccion de mail 'que detallemos un asunto 'que el cuerpo del mail esté redactado 'que si hay un archivo anexo, el mismo exista: For X = 5 To Fin If InStr(1, Cells(X, 2), "@") = 0 Then RevisarTabla = "Error en dirección de mail" Cells(X, 2).Select ElseIf Trim(Cells(X, 3)) = "" Then RevisarTabla = "Falta el asunto" Cells(X, 3).Select ElseIf Trim(Cells(X, 4)) = "" Then RevisarTabla = "Falta el mensaje" Cells(X, 4).Select ElseIf Trim(Cells(X, 5)) <> "" Then If Dir(Trim(Cells(X, 5))) = "" Then RevisarTabla = "El adjunto no existe" Cells(X, 5).Select End If Else 'si no se detectaron errores, la función 'retorna "ok" RevisarTabla = "ok" End If Next X End Function
Utilizo a Trim() para quitar cualquier espacio en blanco, antes y después del texto, que podamos haber dejado por error.
Bueno, así las cosas, ya estamos casi listos, así que pasemos directamente al código en su totalidad:
Dim Email As CDO.Message
Dim Autentificion As Boolean
Dim UltFila, X As Long
Sub EnviarVariosMails_CDO()
'llamo a la función creada (que me conecta al servidor). si devuelve
'false es por que se generaron problemas: aviso y cierro todo
If AbrirConexion = False Then
MsgBox "Se presentaron problemas en la conexion", vbCritical
Set Email = Nothing
End
End If
'almaceno la ultima fila ocupada de la tabla
UltFila = Cells(Cells.Rows.Count, 1).End(xlUp).Row
'llamo a la función para controlar los registros, pasando
'como argumento la ultima fila ocupada de la tabla:
res = RevisarTabla(UltFila)
'si retorna un valor distinto de "ok" es por que algún
'tipo de error encontró:
If res <> "ok" Then
MsgBox res, vbCritical, "Macro cancelada"
'destruyo el objeto y me voy:
Set Email = Nothing
Exit Sub
End If
'Dirección del remitente (nosotros)
Email.From = Trim([b1].Value)
'y comienzo el recorrido de la tabla, tomando los datos
'allí existentes y enviando los mails:
For X = 5 To UltFila
'Dirección del Destinatario
Email.To = Cells(X, 2)
'asunto:
Email.Subject = Cells(X, 3)
'cuerpo
Email.TextBody = Cells(X, 4)
'adjunto:
If Cells(X, 5) <> "" Then
Email.AddAttachment Cells(X, 5)
End If
'antes de enviar actualizamos los datos:
Email.Configuration.Fields.Update
'enviamos el mail
Email.Send
Next X
'destruyo el objeto, para liberar los recursos del sistema
If Not Email Is Nothing Then
Set Email = Nothing
End If
'libero posibles errores
On Error GoTo 0
MsgBox "Envios finalizados", vbInformation
End Sub
Function RevisarTabla(ByVal Fin As Long) As String
'recorro todos los registros de la tabla, revisando:
'que haya una direccion de mail
'que detallemos un asunto
'que el cuerpo del mail esté redactado
'que si hay un archivo anexo, el mismo exista:
For X = 5 To Fin
If InStr(1, Cells(X, 2), "@") = 0 Then
RevisarTabla = "Error en dirección de mail"
Cells(X, 2).Select
Exit Function
ElseIf Trim(Cells(X, 3)) = "" Then
RevisarTabla = "Falta el asunto"
Cells(X, 3).Select
Exit Function
ElseIf Trim(Cells(X, 4)) = "" Then
RevisarTabla = "Falta el mensaje"
Cells(X, 4).Select
Exit Function
ElseIf Trim(Cells(X, 5)) <> "" Then
If Dir(Trim(Cells(X, 5))) = "" Then
RevisarTabla = "El adjunto no existe"
Cells(X, 5).Select
Exit Function
End If
Else
'si no se detectaron errores, la función
'retorna "ok"
RevisarTabla = "ok"
End If
Next X
End Function
Function AbrirConexion() As Boolean
AbrirConexion = False
'ahora doy vida al objeto
Set Email = New CDO.Message
'indicamos los datos del servidor:
Email.Configuration.Fields(cdoSMTPServer) = "smtp.gmail.com"
Email.Configuration.Fields(cdoSendUsingMethod) = 2
'indicamos el nro de puerto. por defecto es el 25, pero gmail usa el 465. hay otro
'(que ahora no recuerdo) pero no me funcionaba... por eso no lo usé mas y lo olvidé
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = CLng(465)
'aqui dejamos en claro si el servidor que usamos requiere o nó autentificación.
'1=requiere, 0=no requiere. Para gmail, entonces, 1
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/" _
& "configuration/smtpauthenticate") = Abs(1)
'segundos para el tiempo maximo de espera. aconsejo no modificarlo:
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 30
'aqui defino como True (verdadera) a la autentificación para el envío de mails.
Autentificacion = True
'ahora configuramos las opciones de login de gmail:
If Autentificacion Then
'nombre de usuario
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/sendusername") = "tudreccion@gmail.com"
'contraseña
Email.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "contraseña"
'si el servidor utiliza SSL (secure socket layer). en gmail: True
Email.Configuration.Fields.Item("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
AbrirConexion = True
Else
AbrirConexion = False
End If
End Function
A las principales variables las declaré al inicio del módulo, para que estén visibles para todos los procedimientos y funciones dentro del mismo. No es una práctica recomendable... pero es por demás de cómoda. =)
No olviden cambiar los parámetros dentro de la función AbrirConexion(): dirección de correo y contraseña, caso contrario no funcionará correctamente.
La tabla completa queda así:
en B1 deberemos ingresar nuestra dirección de correo (from)
Les dejo el link al archivo y un gran saludo a todos, junto al agradecimiento por tantos correos recibidos.
- Obtener enlace
- Correo electrónico
- Otras aplicaciones
Etiquetas
Macros
Etiquetas:
Macros
- Obtener enlace
- Correo electrónico
- Otras aplicaciones
excelente aporte pero tengo una pequeña duda tengo 30 correos en una lista que van desde la celda b8 a la celda b38 como hago para poner todos esos correos en una variable para poderlos enviar?
ResponderEliminaryo haría algo así:
ResponderEliminarDim Correos as string
For X = 8 to 38
Correos=Correos & Cells(X,"B") & ";"
next X
Correos = Left(Correos, (Len(Correos) - 1))
MsgBox Correos
te explico: en la variable Correos voy almacenando todas las direcciones de mail, mediante un bucle, separando a cada una de ellas con punto y coma (;).
Cuando salgo del bucle utilizo la función Left para quitar el último punto y coma de la cadena.
Por ultimo muestro en un msgbox el resultado.
Probá este procedimiento tal cual te lo paso.
Luego incorporalo al sub que envía mails (quita el msgbox) y en la propiedad .To colocas la variable Correos.
Graciass me funciono perfectamente ahora tengo otra duda yo puedo adjuntar en un correo enviado desde la macro una hoja de mi libro?
ResponderEliminarcon la instrucción
ResponderEliminarActiveSheet.Copy
se genera un libro nuevo, conteniendo esa hoja.
Luego guardas el nuevo libro:
ActiveWorkbook.Save "C:\Mis Documentos\Libro_X_Mail.xls"
y usas esa ruta como parámetro para enviar el archivo adjunto.
Ese es un ejemplo, desde ya que puedes modificarlo, poniendo el nombre y directorio reales.
Suerte y cualquier cosa me avisas.
Hola Damian, eres un crack en esto... Cómo puedo hacer para que los correos se envien todos los 1 del mes?
ResponderEliminarGracias Luis por tus palabras.
ResponderEliminarYo utilizaría la función Day() para evaluar si el día del sistema es el primero. Te lo ejemplifico:
If Day(Date) = 1 then
'aqui va el código que dispara lo correos electrónicos
end if
¿Se entiende? Si el día de hoy es igual a 1... se ejecuta la macro.
Cualquier duda, a tu disposición.