Enviar Mail por Macro

Como ya te dije no soy muy hábil en este tema, esta es otra solución que encontré:
Reemplaza lo que tenias en el módulo por esto:
ActiveWorkbook.HasRoutingSlip = True
With ActiveWorkbook.RoutingSlip
.Delivery = xlOneAfterAnother
.Recipients = Array("Usuario1@Dominio", "Usuario2@Dominio")
.Subject = "Asunto"
.Message = "Tetxo"
End With
ThisWorkbook. Route

Encontré esto
En el editor de visual basic ve a menu... herramientas... referencias y agrega las siguientes:
'Microsoft Outlook 9.0 Object Library
'Microsoft Data Formatting Object Library 6.0(SP4)
En un módulo agrega
Public Sub Enviar_Mail()
Dim objOutlook As Outlook.Application
Dim objSession As Outlook.NameSpace
Dim objMessage As Outlook.MailItem
Dim objRecipient As Object
Dim Fichero As String
Dim Destino As String
Fichero = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
'Suponiendo que tienes una lista de 10 destinatarios en la columa Z de la Hoja1
For I = 1 To 10
Set objOutlook = CreateObject("Outlook.Application")
Set objSession = objOutlook.GetNamespace("MAPI")
Set objMessage = objOutlook.CreateItem(olMailItem)
Destino = Hoja1.Cells(I, Range("Z1").Column)
Set objRecipient = objSession.CreateRecipient(Destino)
objSession.Logon
objMessage.Recipients.Add (objRecipient)
objMessage.Subject = "Prueba"
objMessage.Body = "Esta es una Prueba"
objMessage.Attachments.Add (Fichero)
objMessage.Send
objSession.Logoff
Next I
'objMessage.Display
MsgBox "Mensaje enviado exitosamente!"
Set objRecipient = Nothing
Set objOutlook = Nothing
Set objSession = Nothing
Set objMessage = Nothing
End Sub
Yo la ensaye y no produjo errores.

Estimado amigo jgirj, yo estuve muchos días buscando antes de preguntarte a ti sobre los mail por VBA, creo que es una pregunta muy difícil, lo dejo a tu criterio si puedes solucionar mi inconveniente...
La macro me produce error...
Gracias por tu comprensión...

Si encuentro algo útil te aviso

En realidad no soy muy diestro en el uso del correo a través de VBA, pero encontré algo que te puede servir
Sub Enviar_Mail()
Set objOutlook = CreateObject("Outlook.Application")
Set objNameSpace = objOutlook.GetNameSpace("MAPI")
Set objMailItem = objOutlook.CreateItem(0)
Set objRecipient = objMailItem.Recipients.Add("Usuario1@Domino", "Usuario2@dominio")
objRecipient.Type = 1
objMailItem.Subject = "Asunto "
objMailItem.Body = "Texto"
objMailItem.Send
'Esa primera parte enviaría mensajes de texto
ActiveWorkbook.SendMail Array("Usuario1@Domino", "Usuario2@Dominio"), "Asunto", False
'Esta parte enviaría un mensaje con el archivo adjunto
End Sub

El resultado es muy bueno, pero tengo un percance, es que lo que quiero hacer esta por separado, adapte la macro para que funcione en mi macro, pero envía dos correos, mi intención es enviar el archivo adjunto, junto al Asunto y Mensaje...
La macro enviada, los envía por separado...
Por tu comprensión Gracias

La configuración de Herramientas ya estaba bien.
Cuando se genera la macro, en la primera linea
Dim objOutlook As Outlook.Application
El error que genera es
"No se ha definido el tipo definido por el usuario"
Atento a tus comentarios
Gracias

Pon atención e lo siguiente
Los destinatarios están ubicados por separado en cada un a de las filas de la columna Z así:
Z1=destino1@dominio
Z2=destino2@dominio y asi sucesivamente
Ahora, si quieres enviar un archivo diferente al libro desde el que ejecutas la macro entonces a la Variable Fichero ya no sera:
Fichero = ActiveWorkbook.Path & "\" & ActiveWorkbook.Name
sino que debe darsele valor asi, por ejemplo:
Fichero="C:\Temp\Archivo.Extensión", es decir la ruta, el nombre del archivo y la extension (.xls si es un libro de excel, .doc si es un documento de word,.txt si es un archivo de texto, etc).
En cuanto a la librería no te preocupes, en mi computador aparece de igual manera.
Para que detectes donde están los errores ejecuta paso a paso el programa en menú... depuración.. paso a paso, así cuando el programa empiece a depurarse podrás ver el valor de la variable sobre la cual pares el puntero del mouse, para continuar ejecutando instrucción por instrucción da F8. Además para que te evites futuros problemas compila tu proyecto: menu.. depuración.. compilar VBAproject.

Asegurate de haber agregado las referencias a:
'Microsoft Outlook 9.0 Object Library
'Microsoft Data Formatting Object Library 6.0(SP4)
Como te digo yo ya lo corrí y no me genero errores
Estamos en contacto

Tenias razón no había agregado
'Microsoft Outlook 9.0 Object Library
'Microsoft Data Formatting Object Library 6.0(SP4) , salvo que en mi computador dice
'Microsoft Data Formatting Object Library (no incluye el 6.0(SP4)).....
Por otra parte, cuando los incluí ya no genero el error anterior, si no que genero un error en esta linea
objMessage.Attachments.Add (Fichero)
Y dice "SE HA PRODUCIDO EL ERROR '-70844414 (fbc 70002)'
El sistema no puede hallar el archivo especificado.
Yo probé la macro en un libro nuevo llamado"libro1" y en la Hoja1 en la celda Z1, ingrese el nombre de un correo del outlook... y la verdad es que no se cual es el error.
Gracias

Amigo, no se si recibiste mi ultima aclaración... me avisas por fa...

Lo siento, aun no te entiendo, por favor específica cual es exactamente el problema o lo que euieres hacer para poder ayudarte.

¿Cuál es tu aclaración?

Lo que pasa es que justo cuando te escribí, se cayo el internet, bueno lo que pasa es que todo salio a la perfección pero lo que pasa es que tengo que escribir los nombres de los correos en el mismo archivo que el que envío... y lo que pasa es que siempre tengo que enviar un archivo nuevo a las mismas personas y con el mismo asunto... y las macros las tengo grabadas en otro archivo especial, no se si tiene algo que ver con el "destino"... la idea es que la macro lea el fichero desde el archivo donde tengo guardado las macros, pero que envíe el archivo activado...
Gracias
Saludos

¿Ya corregiste el error o necesitas ayuda?

Amigo...
Destino = Workbooks("BASE DATOS VIRTUALES CONSOLIDADA").Hoja6.Cells(i, Range("IC2").Column)
Esto es lo que escribí, ya que en esa dirección esta un nombre de los correos que debo enviar, y me señala el error siguiente:
Ya tengo corejido el
Error 438
El Objeto no Admite esta propiedad o método.
Chao...

La verdad no recibí tu pregunta.
Bueno el problema podrías solucionarlo si creas la lista en el archivo desde el cual ejecutas la macro (supongamos que se llama "LibroMaestro", entonces en la linea de código que dice:
Destino = Hoja1.Cells(I, Range("Z1").Column)
Lo cambias por
Destino = WorkBooks("LibroMaestro").Hoja1.Cells(I, Range("Z1").Column)
Si no entiendes o no funciona escribe de nuevo

Sorry, anote por error el "ya tengo corregido el"
Todavía me sale este error..
Error 438
El Objeto no Admite esta propiedad o método.

Salio todo bien, salvo un detalle...
Ya lo probé y lo único que me causa problema es que la lista de todos los correos al que voy a enviarle tengo que anotarlos en el archivo que tengo que enviar..
Me explico, la lista "ficha" se llena en la hoja 1 en las celda z1 hasta la z 10, resulta que tengo que ingresarla en el archivo que tengo que enviar, la idea es que esa lista este en un archivo anexo al que tengo que enviar...
Si puedes ayudarme te lo agradeceré... el otro día te envíe otra pregunta... ¿la recibiste?
Chao saludos

Ensaya así:
Amigo...
Destino = Workbooks("BASE DATOS VIRTUALES CONSOLIDADA"). WrorkSheets(6). Cells(i, Range("IC2"). Column)
Escribeme si no funciona, aunque ya ensaye y funciona.
Estamos en contacto

Como vas. ¿Lograsta salir del problema?

Esa parte es ralativamente fácil. Si tienes las 5 listas en 5 columnas diferentes entonces puedes hacerlo, por ejemplo si la primera lista esta en la columna Z (columna 1), la segunda en la columna Y (columna 2)... etc la cuestión seria algo así:
columna = InputBox("Elija la lista de usuarios", "Lista?")
columna = val(Range("Z1").Column + (columna - 1))
Destino = Hoja1.Cells(I, columna)
Si no funciona como debe seer vuelve a preguntar

¿Cómo vas, Funcionó?

Estimado amigo mio... la macro funciona muy bien... pero a lo mejor ya sabes que soy bien preguntón...
Lo que ocurre es lo siguiente:
Destino = Workbooks("BASE DATOS VIRTUALES CONSOLIDADA").WrorkSheets(6).Cells(i, Range("IC2").Column)
En el archivo tengo 5 Grupos (listas)de Correos distintos, quiero que a través de msgbox, me pregunte a que grupo quiero enviar el archivo...
Gracias
PD: creo que ya me ayudaste en las respuestas anteriores, por lo tanto si quieres en la siguiente correo-respuesta te puedo finalizar la pregunta y luego te escribo de nuevo...

Recuerda que en elinputbox debes entrar 1,2,... 5

Adapte el Código, y resulto muy bien, te agradezco tu ayuda, espero sigas subiendo en el ranking..
Saludos
Gracias

Funciona a la perfección, cada pie de columna tiene un non ¿mbre, por ejemplo Nombre 1, Nombre 2, Nombre 3, etc... tengo que hacer la macro a prueba de tontos, de este modo le puedo agregar un msgBox, donde me diga:
"Usted Eligió Nombre 2", "desea Continuar", y que tenga las opciones Aceptar o Cancelar, en el caso de Cancelar, me solicite el número nuevamente... y Aceptar, por su puesto que la macro continué...
Me imagino que se puede utilizar un coincidir()...
Me ayudas...
Gracias amigo...