Envío archivo activo por medio de un rango correos
Buenas tardes a tod@s, mucho agradecería en verdad me pudiesen ayudar a despejar esta duda, ya que tengo aproximadamente un mes buscando la solución. Inclusive he visitado la famosa página de Rondebruin y he tratado de adaptar las rutinas sin embargo no he tenido el resultado deseado.
He desarrollado un archivo en Excel, que sirve para llevar un control de los asuntos pendientes de la compañía.
Como campos principales son:
1.- Numero consecutivo de respuesta.
2.- Nombre de la persona involucrada en el asunto a tratar
3.- Puesto
4.- Area de Adscripcion
5.- Correo electronico de la persona.
Para poder abreviar la escritura de todos los datos en los campos anteriormente comentados, selecciono de una lista desplegable en el campo de "Nombre de la persona involucrada" el nombre o nombres de las personas a quien va dirigido el Asunto en cuestión y me desplegá en los otros campos todos los datos referentes a dicha persona, incluyendo hasta el correo electrónico correspondiente.
Cabe aclarar que en el campo de direccion electronica que seria la celda "E17" se visualiza en la pantalla como "[email protected]", sin embargo si posiciono mi cursor en la celda, en la barra de funciones aparece la siguiente formula "=BUSCARV(B17,$T$1:$W$48,4,0)"
Mi solicitud es que si alguien me pudiese ayudar a desarrollar una macro para poder enviar el archivo activo a todos los correos que haya en el rango de "E17 a E35"
Con mucho esfuerzo desarrolle una macro a la cual le puse un botón y manda el archivo pero solo a una sola dirección.
A continuación transcribo dicha macro:
Sub OutlookMailExcelAdjunto()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
Set OutMail = OutApp.CreateItem(0)
ActiveWorkbook.Save
On Error Resume Next
With OutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = Sheets("Hoja1").Range("Z4")
.body = "Atentamente el interesado;"
.Attachments.Add ActiveWorkbook.FullName
.send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Espero y que haya alguien que me pueda ayudar
Gracias
He desarrollado un archivo en Excel, que sirve para llevar un control de los asuntos pendientes de la compañía.
Como campos principales son:
1.- Numero consecutivo de respuesta.
2.- Nombre de la persona involucrada en el asunto a tratar
3.- Puesto
4.- Area de Adscripcion
5.- Correo electronico de la persona.
Para poder abreviar la escritura de todos los datos en los campos anteriormente comentados, selecciono de una lista desplegable en el campo de "Nombre de la persona involucrada" el nombre o nombres de las personas a quien va dirigido el Asunto en cuestión y me desplegá en los otros campos todos los datos referentes a dicha persona, incluyendo hasta el correo electrónico correspondiente.
Cabe aclarar que en el campo de direccion electronica que seria la celda "E17" se visualiza en la pantalla como "[email protected]", sin embargo si posiciono mi cursor en la celda, en la barra de funciones aparece la siguiente formula "=BUSCARV(B17,$T$1:$W$48,4,0)"
Mi solicitud es que si alguien me pudiese ayudar a desarrollar una macro para poder enviar el archivo activo a todos los correos que haya en el rango de "E17 a E35"
Con mucho esfuerzo desarrolle una macro a la cual le puse un botón y manda el archivo pero solo a una sola dirección.
A continuación transcribo dicha macro:
Sub OutlookMailExcelAdjunto()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
Set OutMail = OutApp.CreateItem(0)
ActiveWorkbook.Save
On Error Resume Next
With OutMail
.To = "[email protected]"
.CC = ""
.BCC = ""
.Subject = Sheets("Hoja1").Range("Z4")
.body = "Atentamente el interesado;"
.Attachments.Add ActiveWorkbook.FullName
.send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Espero y que haya alguien que me pueda ayudar
Gracias
1 Respuesta
Respuesta de Elsa Matilde
1
Solo confírmame si el mismo libro se enviará a 'todos' los del rango, en 1 solo envío.
Si así fuese, te sugiero armar una cadena para el campo To:
dim cadena as string
for each cdta in range("E17:E35")
cadena = cadena & cdta & ","
next cdta
Luego la línea del campo 'Para' quedará así:
.To= cadena
No probé el resto de la rutina. Si algo marca error avisame que te envío otra rutina para envío de mail
Si así fuese, te sugiero armar una cadena para el campo To:
dim cadena as string
for each cdta in range("E17:E35")
cadena = cadena & cdta & ","
next cdta
Luego la línea del campo 'Para' quedará así:
.To= cadena
No probé el resto de la rutina. Si algo marca error avisame que te envío otra rutina para envío de mail
Le agradezco infinitamente el que se haya tomado su tiempo para leer mis lineas y dar una pronta respuesta.
En contestación a su pregunta le comento que efectivamente el archivo activo se va a enviar a todas las direcciones de correo que aparecen en la columna "e17;e35"
De igual forma le comento que anexe la rutina que tan amablemente me envío quedando de esta forma, de tal forma que la inserte en el sexto renglón (espero que haya sido el lugar correcto) como podrá usted observar ademas de modificar el to. De acuerdo a sus instrucciones.
Sub OutlookMailExcelAdjunto()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
Set OutMail = OutApp.CreateItem(0)
Dim cadena As String
For Each cdta In Range("E17:E35")
cadena = cadena & cdta & ","
Next cdta
On Error Resume Next
With OutMail
.To = cadena
.CC = ""
.BCC = ""
.Subject = Sheets("Hoja1").Range("Z4")
.body = "fulanito de tal;"
.Attachments.Add ActiveWorkbook.FullName
.send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Sin embargo el activar la rutina, lleva a cabo los procedimientos sin ningún aviso de anomalía, y cuando va enviar el correo me aparece la ventana de outlook que me informa que esta tratando de enviar un correo le confirmo que si y después se supone que lo envía, pero no es así, no envía ningún correo a ninguna dirección, me dirijo a mis archivos enviados y no existe ningún archivo enviado.
Tengo una duda en lo que se refiere al valor de las celdas "e17;e35", ya que el valor de estas resultan de una fórmula BUSCARV, para ser un poco más explicito comento:
Dentro de la celda "e17" aparece un resultado de la formula antes descrita =BUSCARV(B17,$T$1:$W$48,4,0), y en la pantalla se observa [email protected],y aparece como texto, no se esta subrayado como hipervinculo.
Una vez más le agradezco mucho la atención que ha tenido hacia mi persona, esperando me pueda ayudar a descifrar este galimatías.
En contestación a su pregunta le comento que efectivamente el archivo activo se va a enviar a todas las direcciones de correo que aparecen en la columna "e17;e35"
De igual forma le comento que anexe la rutina que tan amablemente me envío quedando de esta forma, de tal forma que la inserte en el sexto renglón (espero que haya sido el lugar correcto) como podrá usted observar ademas de modificar el to. De acuerdo a sus instrucciones.
Sub OutlookMailExcelAdjunto()
Dim OutApp As Object
Dim OutMail As Object
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.logon
Set OutMail = OutApp.CreateItem(0)
Dim cadena As String
For Each cdta In Range("E17:E35")
cadena = cadena & cdta & ","
Next cdta
On Error Resume Next
With OutMail
.To = cadena
.CC = ""
.BCC = ""
.Subject = Sheets("Hoja1").Range("Z4")
.body = "fulanito de tal;"
.Attachments.Add ActiveWorkbook.FullName
.send
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
Sin embargo el activar la rutina, lleva a cabo los procedimientos sin ningún aviso de anomalía, y cuando va enviar el correo me aparece la ventana de outlook que me informa que esta tratando de enviar un correo le confirmo que si y después se supone que lo envía, pero no es así, no envía ningún correo a ninguna dirección, me dirijo a mis archivos enviados y no existe ningún archivo enviado.
Tengo una duda en lo que se refiere al valor de las celdas "e17;e35", ya que el valor de estas resultan de una fórmula BUSCARV, para ser un poco más explicito comento:
Dentro de la celda "e17" aparece un resultado de la formula antes descrita =BUSCARV(B17,$T$1:$W$48,4,0), y en la pantalla se observa [email protected],y aparece como texto, no se esta subrayado como hipervinculo.
Una vez más le agradezco mucho la atención que ha tenido hacia mi persona, esperando me pueda ayudar a descifrar este galimatías.
Esta es la instrucción del sitio mencionado:
ActiveWorkbook.SendMail "[email protected]; [email protected]", _
"This is the Subject line"
Por lo tanto debemos armar esa cadena de direcciones para no colocar cada celda. Te dejo otra rutina un poco más corta pero igualmente funcional:
Sub enviamail()
Dim midire, miasunto As String
Dim wb
'armamos la cadena de destinatarios
For Each cdta In Range("E7:E9")
midire = midire & cdta & "; "
Next cdta
'quitamos la última coma agregada
midire = Left(midire, Len(midire) - 2)
miasunto = ActiveSheet.Range("B6")
Set wb = ActiveWorkbook
On Error GoTo ErrorEnvio
With wb
'enviamos el libro
MsgBox midire
.SendMail midire, miasunto
End With
Set wb = Nothing
Exit Sub
ErrorEnvio:
MsgBox "Se ha presentado un problema...."
End Sub
Pruébala, si da error inhabilitá la línea del On Error colocando una comilla delante y volverlo a probar. Si vuelve a dar error enviame el mensaje que te aparece.
Sdos
Elsa
PD) Queda descontado que ya está en el menú Herramientas la referencia al Outlook habilitada, ¿verdad?
ActiveWorkbook.SendMail "[email protected]; [email protected]", _
"This is the Subject line"
Por lo tanto debemos armar esa cadena de direcciones para no colocar cada celda. Te dejo otra rutina un poco más corta pero igualmente funcional:
Sub enviamail()
Dim midire, miasunto As String
Dim wb
'armamos la cadena de destinatarios
For Each cdta In Range("E7:E9")
midire = midire & cdta & "; "
Next cdta
'quitamos la última coma agregada
midire = Left(midire, Len(midire) - 2)
miasunto = ActiveSheet.Range("B6")
Set wb = ActiveWorkbook
On Error GoTo ErrorEnvio
With wb
'enviamos el libro
MsgBox midire
.SendMail midire, miasunto
End With
Set wb = Nothing
Exit Sub
ErrorEnvio:
MsgBox "Se ha presentado un problema...."
End Sub
Pruébala, si da error inhabilitá la línea del On Error colocando una comilla delante y volverlo a probar. Si vuelve a dar error enviame el mensaje que te aparece.
Sdos
Elsa
PD) Queda descontado que ya está en el menú Herramientas la referencia al Outlook habilitada, ¿verdad?
Estimada Experta, en verdad le agradezco infinitamente la ayuda que me ha brindado, lleve a cabo las instrucciones que tan amablemente me hizo llegar en el segundo block de respuestas y ha sido total y absolutamente satisfactorio el resultado. En lo personal le califico con un 10 o 100% de eficiencia, nuevamente muchas gracias.
