пращане на e-mail от VB6
1 отговора
0 прегледа
пращане на e-mail от VB6
Не ми се сърдете, че питам тук преди да потърся в Google и в дебели книги.
Моля да споделите кода, ако имате готов програмен модул, който да изпраща е-майл
- на определен и непроменящ се адрес
- с тема зададена в една стрингова променлива
- с съдържание, зададено в друга текстова променлива.
- дължината и на съдържанието и темата не надхвърлят 120 знака
Благодаря!
Моля да споделите кода, ако имате готов програмен модул, който да изпраща е-майл
- на определен и непроменящ се адрес
- с тема зададена в една стрингова променлива
- с съдържание, зададено в друга текстова променлива.
- дължината и на съдържанието и темата не надхвърлят 120 знака
Благодаря!
в отговор на нaблюдaвaщ
#2
Re: пращане на e-mail от VB6
Толкава просто нямам. Ето как да пращаш аttachment-и през MAPI
[линк]
Option Explicit
Private Const MODULE_NAME As String = "cSendMail"
'=========================================================================
' Public enums
'=========================================================================
Public Enum UcsSendMailRecipientTypeEnum
ucsSmrMAPI_TO = 1
ucsSmrMAPI_CC = 2
ucsSmrMAPI_BCC = 3
End Enum
Public Enum UcsSendMailActionEnum
ucsSmaShowDialog
ucsSmaDirectSend
End Enum
'=========================================================================
' API declares
'=========================================================================
Private Const MAPI_LOGON_UI As Long = &H1
Private Const MAPI_NEW_SESSION As Long = &H2
Private Const MAPI_DIALOG As Long = &H8
Private Declare Function MAPILogon Lib "MAPI32.DLL" (ByVal UIParam As Long, ByVal User As String, ByVal Password As String, ByVal Flags As Long, ByVal Reserved As Long, Session As Long) As Long
Private Declare Function MAPILogoff Lib "MAPI32.DLL" (ByVal Session As Long, ByVal UIParam As Long, ByVal Flags As Long, ByVal Reserved As Long) As Long
Private Declare Function MAPISendMail Lib "MAPI32.DLL" (ByVal Session As Long, ByVal UIParam As Long, Message As MapiMessage, ByVal Flags As Long, ByVal Reserved As Long) As Long
Private Type MapiMessage
Reserved As Long
Subject As String
NoteText As String
MessageType As Long
DateReceived As Long
ConversationID As Long
Flags As Long
Originator As Long
RecipCount As Long
Recips As Long
FileCount As Long
Files As Long
End Type
Private Type MapiRecip
Reserved As Long
RecipClass As Long
Name As String
Address As String
EIDSize As Long
EntryID As Long
End Type
Private Type MapiFile
Reserved As Long
Flags As Long
Position As Long
PathName As String
FileName As String
FileType As Long
End Type
'=========================================================================
' Constants and member variables
'=========================================================================
Private m_lSession As Long
Private m_uMsg As MapiMessage
Private m_uRecips() As MapiRecip
Private m_uFiles() As MapiFile
'=========================================================================
' Error handling
'=========================================================================
Private Sub PrintError(sFunction As String)
' PushError
' PopPrintError sFunction, MODULE_NAME
End Sub
'=========================================================================
' Properties
'=========================================================================
Property Get Subject() As String
Subject = m_uMsg.Subject
End Property
Property Let Subject(sValue As String)
m_uMsg.Subject = sValue
End Property
Property Get Body() As String
Body = m_uMsg.NoteText
End Property
Property Let Body(sValue As String)
m_uMsg.NoteText = sValue
End Property
'=========================================================================
' Methods
'=========================================================================
Public Function AddAttachment(sFile As String, Optional sName As String) As Boolean
Const FUNC_NAME As String = "AddAttachment"
On Error GoTo EH
If m_uMsg.FileCount > UBound(m_uFiles) Then
ReDim Preserve m_uFiles(0 To 2 * UBound(m_uFiles) + 1)
End If
With m_uFiles(m_uMsg.FileCount)
.Position = -1
.PathName = StrConv(sFile, vbFromUnicode)
.FileName = StrConv(sName, vbFromUnicode)
End With
m_uMsg.FileCount = m_uMsg.FileCount + 1
'--- success
AddAttachment = True
Exit Function
EH:
PrintError FUNC_NAME
Resume Next
End Function
Public Function AddRecipient(sName As String, sAddress As String, Optional ByVal eType As UcsSendMailRecipientTypeEnum = ucsSmrMAPI_TO) As Boolean
Const FUNC_NAME As String = "AddRecipient"
On Error GoTo EH
If m_uMsg.RecipCount > UBound(m_uRecips) Then
ReDim Preserve m_uRecips(0 To 2 * UBound(m_uRecips) + 1)
End If
With m_uRecips(m_uMsg.RecipCount)
.RecipClass = eType
.Name = StrConv(sName, vbFromUnicode)
.Address = StrConv(sAddress, vbFromUnicode)
End With
m_uMsg.RecipCount = m_uMsg.RecipCount + 1
'--- success
AddRecipient = True
Exit Function
EH:
PrintError FUNC_NAME
Resume Next
End Function
Public Function SendMail( _
Optional ByVal eAction As UcsSendMailActionEnum = ucsSmaShowDialog, _
Optional ByVal hWndParent As Long) As Boolean
Const FUNC_NAME As String = "SendMail"
Dim sError As String
On Error GoTo EH
If pvGetError(MAPILogon(hWndParent, vbNullString, vbNullString, MAPI_LOGON_UI Or MAPI_NEW_SESSION, 0, m_lSession), sError) Then
If LenB(sError) <> 0 Then
On Error GoTo 0
Err.Raise vbObjectError, MODULE_NAME, sError
End If
End If
With m_uMsg
.Recips = VarPtr(m_uRecips(0))
.Files = VarPtr(m_uFiles(0))
End With
If pvGetError(MAPISendMail(m_lSession, hWndParent, m_uMsg, IIf(eAction = ucsSmaShowDialog, MAPI_DIALOG, 0), 0), sError) Then
If LenB(sError) <> 0 Then
On Error GoTo 0
Err.Raise vbObjectError, MODULE_NAME, sError
End If
End If
If pvGetError(MAPILogoff(m_lSession, hWndParent, 0, 0), sError) Then
If LenB(sError) <> 0 Then
On Error GoTo 0
Err.Raise vbObjectError, MODULE_NAME, sError
End If
End If
m_lSession = 0
'--- success
SendMail = True
Exit Function
EH:
PrintError FUNC_NAME
Resume Next
End Function
'= private ===============================================================
Private Function pvGetError(ByVal lResult As Long, sError As String) As Boolean
Const STR_ERRORS As String = "||MAPI_E_FAILURE|MAPI_E_LOGIN_FAILURE|MAPI_E_DISK_FULL|MAPI_E_INSUFFICIENT_MEMORY|MAPI_E_BLK_TOO_SMALL||MAPI_E_TOO_MANY_SESSIONS|MAPI_E_TOO_MANY_FILES|MAPI_E_TOO_MANY_RECIPIENTS|MAPI_E_ATTACHMENT_NOT_FOUND|MAPI_E_ATTACHMENT_OPEN_FAILURE|MAPI_E_ATTACHMENT_WRITE_FAILURE|MAPI_E_UNKNOWN_RECIPIENT|MAPI_E_BAD_RECIPTYPE|MAPI_E_NO_MESSAGES|MAPI_E_INVALID_MESSAGE|MAPI_E_TEXT_TOO_LARGE|MAPI_E_INVALID_SESSION|MAPI_E_TYPE_NOT_SUPPORTED|MAPI_E_AMBIGUOUS_RECIPIENT|MAPI_E_MESSAGE_IN_USE|MAPI_E_NETWORK_FAILURE|MAPI_E_INVALID_EDITFIELDS|MAPI_E_INVALID_RECIPS|MAPI_E_NOT_SUPPORTED"
If lResult Then
pvGetError = True
'--- user aborted
If lResult = 1 Then
Exit Function
End If
On Error Resume Next
sError = Split(STR_ERRORS, "|")(lResult)
On Error GoTo 0
If LenB(sError) = 0 Then
sError = "0x" & Hex(lResult)
End If
sError = "MAPI Error: " & sError
Else
sError = vbNullString
End If
End Function
'=========================================================================
' Base class events
'=========================================================================
Private Sub Class_Initialize()
ReDim m_uRecips(0 To 0)
ReDim m_uFiles(0 To 0)
End Sub
Private Sub Class_Terminate()
If m_lSession <> 0 Then
Call MAPILogoff(m_lSession, 0, 0, 0)
m_lSession = 0
End If
End Sub
[линк]