Mandar un email con los datos de un formulario

Como puedo mandar automáticamente un email después de llenar un formulario sin que aparezcan los cuadros de dialogo de Outlook.

1 respuesta

Respuesta
1
Function SMTP_SendMail()
Dim oMsg As CDO.Message
Dim oConf As CDO.Configuration
Dim oFields As Object
Set oMsg = New CDO.Message
Set oConf = New CDO.Configuration
Set oFields = oConf.Fields
With oFields
.Item(cdoSendUsingMethod) = cdoSendUsingPort ' SMTP Mail
.Item(cdoSMTPServer) = "Tu Servidor SMTP o su Dirección IP"
.Item(cdoSMTPConnectionTimeout) = 10
.Item(cdoSMTPAuthenticate) = 0 ' Anónimo
.Update
End With
With oMsg
Set .Configuration = oConf
.To = """Nombre del Receptor"" <dirección email>"
.From = """Nombre del que lo envía"" <dirección email>"
.Subject = "Asunto del mensaje"
.TextBody = "Texto del Mensaje."
.Send
End With
Set oFields = Nothing
Set oConf = Nothing
Set oMsg = Nothing
End Function
Antes de copiar la función, debes ir a herramientas->Referencias e incluir la referencia a "Microsoft CDO for Windows 2000 Library". La librería correspondiente es C:WINDOWSSYSTEM32CDOSYS.DLL
Debajo de esta introducción te envío código para enviar un eMail desde Access pero antes debo hacerte una puntualización:
- Existen dos juegos de librerías de correo en Windows: "Basic MAPI" y "Extended MAPI".
Basic MAPI es accesible desde Visual Basic en todos sus dialectos: VBA (usado en Access, Excel, Word, etc) y VBScript (usado en archivos VBS y en ASP).
Extended MAPI por contra es una colección de Objetos que a su vez son colecciones de Objetos cuyo interface es tan intrincado (Punteros de punteros de punteros ...) que sólo es accesible desde C++ (según microsoft) y desde Delphi (esto lo sé porque he visto rutinas escritas en Delphi que lo usan.
La diferencia: El comportamiento frente a los parches de seguridad que introidujo Microsoft para hacer frente al "I love you" y virus/gusanos similares, escritos en VB, que se propagan utilizando el cliente de correo de la máquina infectada (los más modernos están escritos en C++ e incluyen su propio cliente o servidor de correo). Cuando utilizas Basic MAPI, el sistema de seguridad para y te muestra un cuadro de diálogo (además este cuadro no responde al "SendKeys") en el que te avisa que un programa intenta enviar un mensaje en tu nombre. Extended MAPI pasa por debajo de todo este sistema de seguridad y envía el mensaje sin ningún problema.
Bien. Después de todo este rollo, te envío el código de un módulo con el que puedes enviar un mensaje (OJO, necesitas tener tu cliente de correo abierto).
Option Compare DataBase
Option Explicit
Public Const MAPI_AB_NOMODIFY = &H400
Public Const MAPI_BCC = 3
Public Const MAPI_BODY_AS_FILE = &H200
Public Const MAPI_CC = 2
Public Const MAPI_DIALOG = &H8
Public Const MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT
Public Const MAPI_E_AMBIGUOUS_RECIPIENT = 21
Public Const MAPI_E_ATTACHMENT_NOT_FOUND = 11
Public Const MAPI_E_ATTACHMENT_OPEN_FAILURE = 12
Public Const MAPI_E_ATTACHMENT_WRITE_FAILURE = 13
Public Const MAPI_E_BAD_RECIPTYPE = 15
Public Const MAPI_E_BLK_TOO_SMALL = 6
Public Const MAPI_E_DISK_FULL = 4
Public Const MAPI_E_FAILURE = 2
Public Const MAPI_E_INSUFFICIENT_MEMORY = 5
Public Const MAPI_E_INVALID_EDITFIELDS = 24
Public Const MAPI_E_INVALID_MESSAGE = 17
Public Const MAPI_E_INVALID_RECIPS = 25
Public Const MAPI_E_INVALID_SESSION = 19
Public Const MAPI_E_LOGIN_FAILURE = 3
Public Const MAPI_E_LOGON_FAILURE = MAPI_E_LOGIN_FAILURE
Public Const MAPI_E_MESSAGE_IN_USE = 22
Public Const MAPI_E_NETWORK_FAILURE = 23
Public Const MAPI_E_NO_MESSAGES = 16
Public Const MAPI_E_NOT_SUPPORTED = 26
Public Const MAPI_E_TEXT_TOO_LARGE = 18
Public Const MAPI_E_TOO_MANY_FILES = 9
Public Const MAPI_E_TOO_MANY_RECIPIENTS = 10
Public Const MAPI_E_TOO_MANY_SESSIONS = 8
Public Const MAPI_E_TYPE_NOT_SUPPORTED = 20
Public Const MAPI_E_UNKNOWN_RECIPIENT = 14
Public Const MAPI_E_USER_ABORT = MAPI_USER_ABORT
Public Const MAPI_ENVELOPE_ONLY = &H40
Public Const MAPI_FORCE_DOWNLOAD = &H1000
Public Const MAPI_GUARANTEE_FIFO = &H100
Public Const MAPI_LOGOFF_SHARED = &H1
Public Const MAPI_LOGOFF_UI = &H2
Public Const MAPI_LOGON_UI = &H1
Public Const MAPI_NEW_SESSION = &H2
Public Const MAPI_OLE = &H1
Public Const MAPI_OLE_STATIC = &H2
Public Const MAPI_ORIG = 0
Public Const MAPI_PEEK = &H80
Public Const MAPI_RECEIPT_REQUESTED = &H2
Public Const MAPI_SENT = &H4
Public Const MAPI_SUPPRESS_ATTACH = &H800
Public Const MAPI_TO = 1
Public Const MAPI_UNREAD = &H1
Public Const MAPI_UNREAD_ONLY = &H20
Public Const MAPI_USER_ABORT = 1
Public Const SUCCESS_SUCCESS = 0
Public Type MapiFile
Reserved As Long
Flags As Long
Position As Long
PathName As String
FileName As String
FileType As String
End Type
Public Type MAPIMessage
Reserved As Long
Subject As String
NoteText As String
MessageType As String
DateReceived As String
ConversationID As String
Flags As Long
RecipCount As Long
FileCount As Long
End Type
Public Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As String
End Type
Public Declare Function BMAPIAddress Lib "MAPI32.DLL" (lInfo&, ByVal Session&, ByVal UIParam&, Caption$, ByVal nEditFields&, Label$, nRecipients&, Recip() As MapiRecip, ByVal Flags&, ByVal Reserved&) As Long
Public Declare Function BMAPIGetAddress Lib "MAPI32.DLL" (ByVal lInfo&, ByVal nRecipients&, Recipients() As MapiRecip) As Long
Public Declare Function BMAPIGetReadMail Lib "MAPI32.DLL" (ByVal lMsg&, Message As MAPIMessage, Recip() As MapiRecip, File() As MapiFile, Originator As MapiRecip) As Long
Public Declare Function BMAPIReadMail Lib "MAPI32.DLL" (lMsg&, nRecipients&, nFiles&, ByVal Session&, ByVal UIParam&, MessageID$, ByVal Flag&, ByVal Reserved&) As Long
Public Declare Function MAPIDeleteMail Lib "MAPI32.DLL" (ByVal Session&, ByVal UIParam&, ByVal MsgID$, ByVal Flags&, ByVal Reserved&) As Long
Public Declare Function MAPIDetails Lib "MAPI32.DLL" Alias "BMAPIDetails" (ByVal Session&, ByVal UIParam&, Recipient As MapiRecip, ByVal Flags&, ByVal Reserved&) As Long
Public Declare Function MAPIFindNext Lib "MAPI32.DLL" Alias "BMAPIFindNext" (ByVal Session&, ByVal UIParam&, MsgType$, SeedMsgID$, ByVal Flag&, ByVal Reserved&, MsgID$) As Long
Public Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal Session&, ByVal UIParam&, ByVal Flags&, ByVal Reserved&) As Long
Public Declare Function MAPILogon Lib "MAPI32.DLL" (ByVal UIParam&, ByVal User$, ByVal Password$, ByVal Flags&, ByVal Reserved&, Session&) As Long
Public Declare Function MAPIResolveName Lib "MAPI32.DLL" Alias "BMAPIResolveName" (ByVal Session&, ByVal UIParam&, ByVal UserName$, ByVal Flags&, ByVal Reserved&, Recipient As MapiRecip) As Long
Public Declare Function MAPISaveMail Lib "MAPI32.DLL" Alias "BMAPISaveMail" (ByVal Session&, ByVal UIParam&, Message As MAPIMessage, Recipient() As MapiRecip, File() As MapiFile, ByVal Flags&, ByVal Reserved&, MsgID$) As Long
Public Declare Function MAPISendDocuments Lib "MAPI32.DLL" (ByVal UIParam&, ByVal DelimStr$, ByVal FilePaths$, ByVal FileNames$, ByVal Reserved&) As Long
Public Declare Function MAPISendMail Lib "MAPI32.DLL" Alias "BMAPISendMail" (ByVal Session&, ByVal UIParam&, Message As MAPIMessage, Recipient() As MapiRecip, File() As MapiFile, ByVal Flags&, ByVal Reserved&) As Long
Public Function SendMail(FrmDatos as Form) As Long
Dim sDireccion As String ' Para leer la Dirección en el Control.
Dim oMAPIMsg As MAPIMessage ' Objeto Mensaje
ReDim tbRecip(0 To 0) As MapiRecip ' Tabla de Destinatarios.
ReDim tbAnexos(0 To 0) As MapiFile ' Tabla de Archivos Anexos.
Dim lMailSession As Long
Dim lReturnCode As Long
' Compruebo que el campo no está vacío
'-------------------------------------
If IsNull(FrmDatos.CampoEmail) Then
MsgBox "No hay Destinatario." + vbCrLf + "No se enlazará con el Correo.", vbApplicationModal + vbExclamation + vbOKOnly, "Send Mail"
Exit Function
End If
sDireccion = Trim$(CStr(FrmDatos.CampoEmail))
If sDireccion = "" Then
MsgBox "No hay Destinatario." + vbCrLf + "No se enlazará con el Correo.", vbApplicationModal + vbExclamation + vbOKOnly, "Send Mail"
Exit Function
End If
' Genero la tabla de Direcciones.
'--------------------------------
tbRecip(0).Reserved = 0&
tbRecip(0).RecipClass = MAPI_TO
tbRecip(0).Name = sDireccion
tbRecip(0).EIDSize = 0&
tbRecip(0).EntryID = ""
' Genero el cuerpo del Mensaje.
'------------------------------
oMAPIMsg.Subject = FrmDatos.Asunto
oMAPIMsg.MessageType = ""
oMAPIMsg.NoteText = FrmDatos.TextoMsg
oMAPIMsg.RecipCount = 1
oMAPIMsg.FileCount = 0
' Conecto con el sistema de Correo
' Y compruebo el código de Retorno.
' MAPI_LOGON_UI obliga a que si no
' Está arrancado el correo,
' Aparezca la pantalla de LogOn.
'----------------------------------
lReturnCode = MAPILogon(0&, "", "", MAPI_LOGON_UI, 0&, lMailSession)
If lReturnCode = SUCCESS_SUCCESS Then
' Si he conectado, hago el envío.
' MAPI_DIALOG fuerza a que aparezca
' el interface del sistema de correo
' instalado.
'--------------------------------
lReturnCode = MAPISendMail(0&, 0&, oMAPIMsg, tbRecip, tbAnexos, 0&, 0&)
If lReturnCode <> SUCCESS_SUCCESS Then
If lReturnCode = MAPI_E_USER_ABORT Then
MsgBox "Envío Cancelado por el usuario", vbApplicationModal + vbInformation + vbOKOnly, "SendMail"
Else
MsgBox "Código de Error: " & lReturnCode, vbApplicationModal + vbInformation + vbOKOnly, "SendMail"
End If
End If
Else
If lReturnCode = MAPI_E_USER_ABORT Then
MsgBox "Envío Cancelado por el usuario", vbApplicationModal + vbInformation + vbOKOnly, "SendMail"
Else
MsgBox "Código de Error: " & lReturnCode, vbApplicationModal + vbInformation + vbOKOnly, "SendMail"
End If
End If
' Hago logoff de la sesión de Correo.
' Aquí ya no me importa el retorno.
'------------------------------------
lReturnCode = MAPILogoff(lMailSession, 0&, 0&, 0&)
End Function
En esta función, FrmDatos es el Formulario en el que tienes el Mensaje. Tienes que cambiar los nombres de los campos del Form por los equivalentes que tengas tú en tu Formulario.
Hay orta forma de enviar un mensaje y es utilizando CDOSYS pero necesitas tener un servidor SMTP al que puedas acceder. Si este es tu caso, también te puedo mandar una función para utilizarlo.
Repito: Recuerda que esto utiliza Basic MAPI y que te aparecerá una ventana de diálogo pidiendo permiso para enviar el mensaje.

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas