Bueno aqui te dejo varios enlaces que personalmente no probe ya que yo envio un mail es por lotus note, sin embargo se ve que el proceso es el mismo cuando hice una comparacion de estos enlaces con mi codigo.
1) http://support.microsoft.com/kb/213712/es
2)http://www.excel-avanzado.com/17087/enviar-correo-electronico-lista-de-contactos.html
3)http://www.excel-avanzado.com/11930/enviar-adjunto-email.html
4)http://www.youtube.com/watch?v=HYZHcLdmW0Y
5)http://damianexcel.blogspot.com/2010/03/macros-como-enviar-mails-desde-excel.html
Ya solo queda que revises pruebes y adaptes a tus necesidades. Espero haberte ayudado de todas maneras dejare el codigo que uso para enviar desde lotus note
' Envia un correo a travez del loyus note con archivo adjunto
' codigo original por Nate Oliver (NateO)
'Modificado por Manuel Escalona
Dim UserName As String
Dim MailDbName As String
Dim Recipient As String
Dim ccRecipient As String
Dim ans As String
Dim Attachment1 As String
Dim Maildb As Object
Dim MailDoc As Object
Dim AttachME As Object
Dim Session As Object
Dim EmbedObj1 As Object
With Application
.ScreenUpdating = False
.DisplayAlerts = False
' Abro y localizo la sesion actual del usario de LOTUS NOTES
'para que el proceso funcione el usuario debio iniciar sesion con lotus note previamente
Set Session = CreateObject("Notes.NotesSession")
UserName = Session.UserName
MailDbName = Left$(UserName, 1) & Right$(UserName, (Len(UserName) - InStr(1, UserName, " "))) & ".nsf"
Set Maildb = Session.GetDatabase("", MailDbName)
If Maildb.IsOpen = True Then
Else
Maildb.OPENMAIL
End If
' Create New Mail and Address Title Handlers
Set MailDoc = Maildb.CREATEDOCUMENT
MailDoc.Form = "Memo"
' Select range of e-mail addresses
Recipient = InputBox("Por favor inserte la direccion E-mail" _
, "Insertar Direccion E-mail")
MailDoc.SendTo = Recipient
ans = MsgBox("Le gustaria enviar una copia (cc) a alguien de este mensaje?" _
, vbQuestion & vbYesNo, "Enviar Copia")
If ans = vbYes Then
ccRecipient = InputBox("Por favor inserte las direcciones recipientes adicionales" _
, "Insertar Direcciones E-mail")
MailDoc.CopyTo = ccRecipient
End If
MailDoc.Subject = InputBox("Asunto" _
, "Insertar Asunto")
MailDoc.Body = _
"Nomina. Reporte su recibimiento ."
' Select Workbook to Attach to E-Mail
MailDoc.SaveMessageOnSend = True
Attachment1 = Application.GetOpenFilename(Title:="Buscar Envio", _
filefilter:="Excel files (*.xlsx), *.xlsx")
'ActiveWorkbook.Name '"C:\\YourFile.xls" ' Required File Name
If Attachment1 <> "" Then
'On Error Resume Next
Set AttachME = MailDoc.CREATERICHTEXTITEM("Attachment1")
Set EmbedObj1 = AttachME.embedobject(1454, "Attachment1", Attachment1, "") 'Required File Name 'AttachME.embedobject(1454, "", "Attachment1", Attachment1) 'Required File Name
'On Error Resume Next
End If
MailDoc.PostedDate = Now()
On Error GoTo errorhandler1
MailDoc.SEND 0, Recipient
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing
.ScreenUpdating = True
.DisplayAlerts = True
End With
errorhandler1:
Set Maildb = Nothing
Set MailDoc = Nothing
Set AttachME = Nothing
Set Session = Nothing
Set EmbedObj1 = Nothing