Envío de email

Yo hago lo que quieres usando las API de Windows, en concreto la MAPI.
Para ello, en el diseño de un módulo selecciono la referencia (en el menú de herramientas) a 'Microsoft MAPI Control 6.0'. Si no la tuvieras igual la puedes localizar con el botón de 'examinar' en la carpeta 'system32' y se llama 'msmapi32.ocx'.
Una vez que tienes la referencia... a usarla. Te pongo un ejemplo del código que utilizo en una de mis bases de datos. Un saludo
Option Compare Database
Option Explicit
Sub enviarTodosLosCorreos()
    Dim rs As Recordset
    Dim miMail As New MAPISession
    miMail.SignOn
    Set rs = CurrentDb().OpenRecordset("select * from <tabla o consulta> where not snEnviado")
    If Not rs.EOF Then
        rs.MoveLast
        rs.MoveFirst
    End If
    SysCmd acSysCmdInitMeter, "Enviando correo", rs.RecordCount
    Do While Not rs.EOF
        SysCmd acSysCmdUpdateMeter, rs.AbsolutePosition + 1
        DoEvents
        EnviarCorreo miMail, rs
        Rs. MoveNext
    Loop
    Rs. Close
    SysCmd acSysCmdClearStatus
    MiMail. SignOff
End Sub
Sub enviarCorreo(ByRef miMail As MAPISession, ByRef rs As Recordset)
    Static snAbierto As Boolean
    Dim miMensaje As New MAPIMessages
    miMensaje.SessionID = miMail.SessionID
    miMensaje.Compose
    ' Destinatario
    miMensaje.RecipIndex = miMensaje.RecipCount
    miMensaje.RecipType = 1
    miMensaje.RecipDisplayName = rs!mailDestinatario
    On Error Resume Next
    miMensaje.ResolveName
    On Error GoTo 0
    If Err Then
        MsgBox "¡¡¡Error!!!" & vbCrLf & _
               "No se ha encontrado el destinatario:" & vbCrLf & rs!mailDestinatario & vbCrLf & vbCrLf & _
               "Se eliminará de la lista de destinatarios", vbExclamation + vbOKOnly, "Enviar correo"
        miMensaje.Action = 14
    End If
    ' Asunto, texto y acuse de recibo
    miMensaje.MsgSubject = rs!mailAsunto
    miMensaje.MsgNoteText = Space(10) & vbCrLf & rs!mailTexto
    miMensaje.MsgReceiptRequested = True
    ' Ficheros adjuntos
    ' Comprobamos si hay fichero 01 y lo ponemos primero
    If Not IsNull(rs!mailAdjuntar01) Then
        miMensaje.AttachmentIndex = miMensaje.AttachmentCount
        miMensaje.AttachmentName = sinPath(rs!mailAdjuntar01)
        miMensaje.AttachmentPathName = rs!mailAdjuntar01
    End If
    miMensaje.AttachmentIndex = miMensaje.AttachmentCount
    miMensaje.AttachmentName = sinPath(rs!mailAdjuntar00)
    miMensaje.AttachmentPathName = rs!mailAdjuntar00
    If Not IsNull(rs!mailAdjuntar01) Then
        miMensaje.AttachmentPosition = 1
      Else
        miMensaje.AttachmentPosition = 0
    End If
    miMensaje.AttachmentType = 0
    miMensaje.Send
    rs.Edit
    rs!snEnviado = True
    rs.Update
End Sub
Function sinPath(ByVal nomFich As String) As String
    Do While InStr(nomFich, "\") > 0
        nomFich = Right$(nomFich, Len(nomFich) - InStr(nomFich, "\"))
    Loop
    sinPath = nomFich
End Function
Function existeFichero(ByVal nomFich As String) As Boolean
    Dim d As String
    On Error Resume Next
    d = Dir$(nomFich)
    existeFichero = (d <> "") And (Err = 0)
    On Error GoTo 0
End Function