Как отправить E-mail при помощи MAPI

Option Explicit

'-- MODULE
'-- used for sending mail with api and outlook objects
'-- can be used in MS Access or Visual Basic
'-- MAPI constants
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_AMBIGUOUS_RECIPIENT = 21
Public Const MAPI_E_AMBIG_RECIP = MAPI_E_AMBIGUOUS_RECIPIENT
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_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 MAPI_E_USER_ABORT = MAPI_USER_ABORT
Public Const SUCCESS_SUCCESS = 0
'-- mapi message recipient object type


Public Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As String
End Type
'-- mapi message file object type


Public Type MapiFile
Reserved As Long
Flags As Long
Position As Long
PathName As String
FileName As String
FileType As String
End Type
'-- mapi message object 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 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 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 api_SendMail(sTo As String, sSubject As String, sMessage As String)

'-- use api functions to send mail
On Error Goto Err_Trap
Dim Rtn As Long '-- return value For api calls
Dim objMsg As MAPIMessage'-- message object
Dim objRec() As MapiRecip'-- recipient object array
Dim objFile() As MapiFile'-- file object array
Dim hMAPI As Long'-- session handle
ReDim objRec(1)
ReDim objFile(1)
'-- file object *************************************************
' *************
'-- default - not expecting to send a file
objFile(0).Reserved = 0
'-- values not used for file
'objFile(0).Flags
'objFile(0).Position
'objFile(0).PathName
'objFile(0).FileName
'objFile(0).FileType
'-- recipient object ********************************************
' *************
objRec(0).Reserved = 0
objRec(0).RecipClass = 1
objRec(0).Name = sTo
'-- values not used for recipient
'objRec.Address
'objRec.EIDSize
'objRec.EntryID
'-- message object **********************************************
' *************
objMsg.Reserved = 0
objMsg.Subject = sSubject
objMsg.RecipCount = 1
objMsg.FileCount = 0
objMsg.NoteText = sMessage
'-- values not used for message
'objMsg.MessageType
'objMsg.DateReceived
'objMsg.ConversationID
'objMsg.Flags
'-- make api calls to send mail *********************************
' **************
'-- logon to MAPI application
'-- default profile is set in user name parameter of Logon
Rtn = MAPILogon(0, "MS Exchange Settings", "", MAPI_LOGON_UI, 0, hMAPI)
'-- send mail message through MAPI
Rtn = MAPISendMail(hMAPI, 0, objMsg, objRec, objFile, 0, MAPI_DIALOG)
'-- logoff MAPI application
Rtn = MAPILogoff(hMAPI, 0, 0, 0)
Exit Function
Err_Trap:
ErrorCatch "MOD_MAIL.api_SendMail()"

End Function
Public Function olk_SendMail(sTo As String, sSubject As String, sMessage As String)

'-- use MS Outlook object to send mail
On Error Goto Err_Trap
Dim objOutlook As Outlook.Application
Dim objMailItem As Outlook.MailItem
Set objOutlook = New Outlook.Application
Set objMailItem = objOutlook.CreateItem(olMailItem)

With objMailItem
.To = sTo
.Subject = sSubject
.Body = sMessage
.Send
End With
Set objMailItem = Nothing
Set objOutlook = Nothing
Exit Function
Err_Trap:

ErrorCatch "MOD_MAIL.olk_SendMail()"

End Function

Public Function ErrorCatch(sDesc As String)

Dim msg As String
msg = vbTab & vbTab & "ERROR OCCURRED!!" & vbCrLf & vbCrLf
msg = msg & "Function :" & vbTab & sDesc & vbCrLf
msg = msg & "Number :" & vbTab & Err.Number & vbCrLf
msg = msg & "Message :" & vbTab & Err.DESCRIPTION
MsgBox msg, vbCritical, "Program Error"
Err.Clear

End Function