-Поиск по дневнику

Поиск сообщений в rss_sql_ru_access_programming

 -Подписка по e-mail

 

 -Постоянные читатели

 -Статистика

Статистика LiveInternet.ru: показано количество хитов и посетителей
Создан: 16.03.2006
Записей:
Комментариев:
Написано: 4


SendEMail. Учетная запись.

Понедельник, 09 Июня 2014 г. 14:40 + в цитатник
Добрый день.
Для отправки почты пользуюсь функцией SendEMail. Вот она:

Global Const SUCCESS_SUCCESS = 0
Global Const MAPI_USER_ABORT = 1
Global Const MAPI_E_FAILURE = 2
Global Const MAPI_E_LOGIN_FAILURE = 3
Global Const MAPI_E_DISK_FULL = 4
Global Const MAPI_E_INSUFFICIENT_MEMORY = 5
Global Const MAPI_E_BLK_TOO_SMALL = 6
Global Const MAPI_E_TOO_MANY_SESSIONS = 8
Global Const MAPI_E_TOO_MANY_FILES = 9
Global Const MAPI_E_TOO_MANY_RECIPIENTS = 10
Global Const MAPI_E_ATTACHMENT_NOT_FOUND = 11
Global Const MAPI_E_ATTACHMENT_OPEN_FAILURE = 12
Global Const MAPI_E_ATTACHMENT_WRITE_FAILURE = 13
Global Const MAPI_E_UNKNOWN_RECIPIENT = 14
Global Const MAPI_E_BAD_RECIPTYPE = 15
Global Const MAPI_E_NO_MESSAGES = 16
Global Const MAPI_E_INVALID_MESSAGE = 17
Global Const MAPI_E_TEXT_TOO_LARGE = 18
Global Const MAPI_E_INVALID_SESSION = 19
Global Const MAPI_E_TYPE_NOT_SUPPORTED = 20
Global Const MAPI_E_AMBIGUOUS_RECIPIENT = 21
Global Const MAPI_E_MESSAGE_IN_USE = 22
Global Const MAPI_E_NETWORK_FAILURE = 23
Global Const MAPI_E_INVALID_EDITFIELDS = 24
Global Const MAPI_E_INVALID_RECIPS = 25
Global Const MAPI_E_NOT_SUPPORTED = 26
Global Const MAPI_E_NO_LIBRARY = 999
Global Const MAPI_E_INVALID_PARAMETER = 998

Global Const MAPI_ORIG = 0
Global Const MAPI_TO = 1
Global Const MAPI_CC = 2
Global Const MAPI_BCC = 3

Global Const MAPI_UNREAD = 1
Global Const MAPI_RECEIPT_REQUESTED = 2
Global Const MAPI_SENT = 4


'***********************
' FLAG Declarations
'***********************
Global Const MAPI_LOGON_UI = &H1
Global Const MAPI_NEW_SESSION = &H2
Global Const MAPI_DIALOG = &H8
Global Const MAPI_UNREAD_ONLY = &H20
Global Const MAPI_ENVELOPE_ONLY = &H40
Global Const MAPI_PEEK = &H80
Global Const MAPI_GUARANTEE_FIFO = &H100
Global Const MAPI_BODY_AS_FILE = &H200
Global Const MAPI_AB_NOMODIFY = &H400
Global Const MAPI_SUPPRESS_ATTACH = &H800
Global Const MAPI_FORCE_DOWNLOAD = &H1000

Global Const MAPI_OLE = &H1
Global Const MAPI_OLE_STATIC = &H2

Type MapiRecip
   Reserved As Long
   RecipClass As Long
   Name As String
   Address As String
   EIDSize As Long
   EntryID As Long 'Originally String
End Type

Type MAPIFileTag 'Not used at all now
   Reserved As Long
   TagLength As Long
   tag() As Byte
   EncodingLength As Long
   Encoding() As Byte
End Type

Type MapiFile
   Reserved As Long
   Flags As Long
   Position As Long
   PathName As String
   FileName As String
   FileType As Long 'Originally MAPIFileTag
End Type

Type MAPIMessage
   Reserved As Long
   Subject As String
   NoteText As String
   MessageType As String
   DateReceived As String
   ConversationID As String
   Flags As Long ' Swapped with Originator
   Originator As Long ' Swapped with Flags
   RecipCount As Long
   Recipients As Long
   FileCount As Long ' Swapped with Files
   Files As Long ' Swapped with Filecount
End Type


Declare Function MAPILogon Lib "c:\program files\outlook express\msoe.dll" _
(ByVal UIParam&, ByVal User$, ByVal Password$, _
ByVal Flags&, ByVal Reserved&, Session&) As Long
Declare Function MAPILogoff Lib "c:\program files\outlook express\msoe.dll" _
(ByVal Session&, ByVal UIParam&, ByVal Flags&, _
ByVal Reserved&) As Long
Declare Function MAPISaveMail Lib "c:\program files\outlook express\msoe.dll" _
(ByVal Session As Long, ByVal UIParam As Long, _
Message As MAPIMessage, ByVal Flags As Long, _
ByVal Reserved As Long, MsgID As String) As Long
Declare Function MAPISendMail Lib "c:\program files\outlook express\msoe.dll" _
(ByVal Session As Long, ByVal UIParam As Long, _
Message As MAPIMessage, ByVal Flags As Long, _
ByVal Reserved As Long) As Long
Declare Function MAPIAddress Lib "c:\program files\outlook express\msoe.dll" _
(lInfo&, ByVal Session&, ByVal UIParam&, _
Caption$, ByVal nEditFields&, Label$, nRecipients&, Recip() _
As MapiRecip, ByVal Flags&, ByVal Reserved&) As Long
Declare Function MAPIDeleteMail Lib "c:\program files\outlook express\msoe.dll" _
(ByVal Session&, ByVal UIParam&, ByVal MsgID$, _
ByVal Flags&, ByVal Reserved&) As Long
Declare Function MAPIDetails Lib "c:\program files\outlook express\msoe.dll" _
(ByVal Session&, ByVal UIParam&, Recipient As MapiRecip, _
ByVal Flags&, ByVal Reserved&) As Long
Declare Function MAPIFindNext Lib "c:\program files\outlook express\msoe.dll" _
(ByVal Session&, ByVal UIParam&, MsgType$, SeedMsgID$, _
ByVal Flag&, ByVal Reserved&, MsgID$) As Long
Declare Function MAPIReadMail Lib "c:\program files\outlook express\msoe.dll" _
(lMsg&, nRecipients&, nFiles&, ByVal Session&, _
ByVal UIParam&, MessageID$, ByVal Flag&, _
ByVal Reserved&) As Long
Declare Function MAPIResolveName Lib "c:\program files\outlook express\msoe.dll" _
(ByVal Session&, ByVal UIParam&, ByVal UserName$, _
ByVal Flags&, ByVal Reserved&, Recipient As MapiRecip) As Long
Declare Function MAPISendDocuments Lib "c:\program files\outlook express\msoe.dll" _
(ByVal UIParam&, ByVal DelimStr$, ByVal FilePaths$, _
ByVal FileNames$, ByVal Reserved&) As Long



Public Sub SendEMail(strEmailAddress As String, strFileName As String, strSubject As String, strBody As String)
Dim Junk As Long
Dim OESession As Long
Dim OEmessage As MAPIMessage
Dim OERecipients() As MapiRecip
Dim OEFiles() As MapiFile
Dim OERecipientCount As Long
Dim OEFileCount As Long
ReDim OERecipients(0 To 100)
ReDim OEFiles(0 To 10)

    ' Login to Outlook Express
    MAPILogon 0, "", "", MAPI_NEW_SESSION, 0, OESession
    
    ' Set subject and message text
    OEmessage.NoteText = strBody
    OEmessage.Subject = strSubject
    
    ' Set recipient address (assuming only one)
    OERecipients(0).RecipClass = MAPI_TO
    OERecipients(0).Address = StrConv("smtp:" & strEmailAddress, vbFromUnicode)
    OERecipientCount = 1
    ReDim Preserve OERecipients(0 To OERecipientCount - 1)
    OEmessage.RecipCount = OERecipientCount
    OEmessage.Recipients = VarPtr(OERecipients(0))
    
    'Attach any files (assuming only one)
    OEFileCount = 1
    OEFiles(0).PathName = StrConv(strFileName, vbFromUnicode)
    
    ReDim Preserve OEFiles(0 To OEFileCount - 1)
    OEmessage.FileCount = OEFileCount
    OEmessage.Files = VarPtr(OEFiles(0))
    
    ' Send the message
     Junk = MAPISendMail(0, 0, OEmessage, 0, 0)
     If Junk <> 0 Then MsgBox "OE SendMail failure (" & Format$(Junk) & ")"
End Sub


Она замечательно работает. Все устраивает. Но. Отправка происходит из почтового ящика заданного по умолчанию. Можно ли усовершенствовать данную функцию, добавив в нее возможность отправлять письма используя учетную запись не определенную по умолчанию.

Вин ХР. Outlook Express

Заранее спасибо

http://www.sql.ru/forum/1099316/sendemail-uchetnaya-zapis


 

Добавить комментарий:
Текст комментария: смайлики

Проверка орфографии: (найти ошибки)

Прикрепить картинку:

 Переводить URL в ссылку
 Подписаться на комментарии
 Подписать картинку