Puedes hacerlo usando el control Winsock y conversando directamente con el servidor de correo, a través del protocolo SMTP, cuya descripción puedes leer en la RFC0821 (www.ietf.org). Te muestro un pequeño ejemplo.
En el formulario incluye un control Winsock llamado winsock1. En la declaración incluye lo siguiente:
Private Sres as String
En el evento winsock1_DataArrival incluye lo siguiente:
Dim Data As String
Dim Length As Long
Winsock1.GetData Data
Length = Len(Data)
Sres = Left$(Data, 3)
Y en el lugar donde quieres enviar el mail incluye:
Dim Inicio as single, Tiempo as single,Timeout as integer
Timeout=60
Winsock1.RemotePort = 25
Winsock1.RemoteHost = "smtp.prueba.es" ' Nombre del servidor de correo
Winsock1.Connect
Inicio = Timer
Do Until Sres = "220"
DoEvents
Tiempo = Timer - Inicio
If Tiempo > Timeout Then
Winsock1.Close
Screen.MousePointer = vbDefault
MsgBox "Agotado el tiempo de espera en la conexión." & _
vbCrLf & "Estado del socket: " & Winsock1.State & _
vbCrLf & "Última respuesta del servidor de correo: " & Sres, vbCritical + vbOKOnly, "Envio e-mail"
Exit Sub
End If
Loop
Sres = "0"
Winsock1.SendData "HELO Prueba" & vbCrLf
Inicio = Timer
Do Until Sres = "250"
DoEvents
Tiempo = Timer - Inicio
If Tiempo > Timeout Then
Winsock1.Close
Screen.MousePointer = vbDefault
MsgBox "Agotado el tiempo de espera al enviar comando HELO." & _
vbCrLf & "Estado del socket: " & Winsock1.State & _
vbCrLf & "Última respuesta del servidor de correo: " & Sres, vbCritical + vbOKOnly, "Envio e-mail"
Exit Sub
End If
Loop
Sres = "0"
Winsock1.SendData "MAIL FROM:Juan<
[email protected]>" & vbCrLf
Inicio = Timer
Do Until Sres = "250"
DoEvents
Tiempo = Timer - Inicio
If Tiempo > Timeout Then
Winsock1.Close
Screen.MousePointer = vbDefault
MsgBox "Agotado el tiempo de espera al enviar comando MAIL FROM." & _
vbCrLf & "Estado del socket: " & Winsock1.State & _
vbCrLf & "Última respuesta del servidor de correo: " & Sres, vbCritical + vbOKOnly, "Envio e-mail"
Exit Sub
End If
Loop
Sres = "0"
Winsock1.SendData "RCPT TO:<
[email protected]>" & vbCrLf
Inicio = Timer
Do Until Sres = "250"
DoEvents
Tiempo = Timer - Inicio
If Tiempo > Timeout Then
Winsock1.Close
Screen.MousePointer = vbDefault
MsgBox "Agotado el tiempo de espera al enviar comando RCPT TO." & _
vbCrLf & "Estado del socket: " & Winsock1.State & _
vbCrLf & "Última respuesta del servidor de correo: " & Sres, vbCritical + vbOKOnly, "Envio e-mail"
Exit Sub
End If
Loop
Sres = "0"
Winsock1.SendData "DATA" & vbCrLf
Inicio = Timer
Do Until Sres = "354"
DoEvents
Tiempo = Timer - Inicio
If Tiempo > Timeout Then
Winsock1.Close
Screen.MousePointer = vbDefault
MsgBox "Agotado el tiempo de espera al enviar comando DATA." & _
vbCrLf & "Estado del socket: " & Winsock1.State & _
vbCrLf & "Última respuesta del servidor de correo: " & Sres, vbCritical + vbOKOnly, "Envio e-mail"
Exit Sub
End If
Loop
Winsock1.SendData "Texto del mensaje." & vbcrlf
' Repite lo de arriba hasta enviar todo el texto del mensaje
' Para finalizar el envio haz lo de abajo
Winsock1.SendData "." & vbcrlf
Inicio = Timer
Do Until Sres = "250"
DoEvents
Tiempo = Timer - Inicio
If Tiempo > Timeout Then
Winsock1.Close
Screen.MousePointer = vbDefault
MsgBox "Agotado el tiempo de espera al enviar el texto del mensaje." & _
vbCrLf & "Estado del socket: " & Winsock1.State & _
vbCrLf & "Última respuesta del servidor de correo: " & Sres, vbCritical + vbOKOnly, "Envio e-mail"
Exit Sub
End If
Loop
Winsock1.SendData "QUIT" & vbCrLf
Inicio = Timer
Do Until Sres = "250"
DoEvents
Tiempo = Timer - Inicio
If Tiempo > Timeout Then
Winsock1.Close
Screen.MousePointer = vbDefault
MsgBox "Agotado el tiempo de espera al enviar el comando QUIT." & _
vbCrLf & "Estado del socket: " & Winsock1.State & _
vbCrLf & "Última respuesta del servidor de correo: " & Sres, vbCritical + vbOKOnly, "Envio e-mail"
Exit Sub
End If
Loop
Winsock1.Close
Winsock1.LocalPort = 0
MsgBox "Correo electrónico enviado satisfactoriamente."
En cualquier caso te recomiendo que leas la RFC0821 para entender como funciona el protocolo de envío de correo.