Отправка файлов по почте - VB
Формулировка задачи:
как отправить файл по почте через VB?
Решение задачи: «Отправка файлов по почте»
textual
Листинг программы
'Как отправить E-mail при помощи MAPI 'www.sources.ru 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д